Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/NEMO_book.tex
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/NEMO_book.tex	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/NEMO_book.tex	(revision 6440)
@@ -215,6 +215,6 @@
 %\date{\today}
 \date{
-November 2014  \\
-{\small  -- version 3.6 --} \\
+January 2016  \\
+{\small  -- version 3.6 stable --} \\
 ~  \\
 \textit{\small Note du P\^ole de mod\'{e}lisation de l'Institut Pierre-Simon Laplace No 27 }\\
@@ -316,6 +316,6 @@
 \include{./TexFiles/Chapters/Annex_B}			% diffusive operator
 \include{./TexFiles/Chapters/Annex_C}			% Discrete invariants of the eqs.
+\include{./TexFiles/Chapters/Annex_ISO}	                  % Isoneutral diffusion using triads
 \include{./TexFiles/Chapters/Annex_D}			% Coding rules
-\include{./TexFiles/Chapters/Annex_ISO}	                  % Isoneutral diffusion using triads
 %\include{./TexFiles/Chapters/Annex_E}	                  % Notes on some on going staff (no included in the DOC)
 %\include{./TexFiles/Chapters/Annex_Fox-Kemper}   % Notes on Fox-Kemper (no included in the DOC)
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Biblio/Biblio.bib
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Biblio/Biblio.bib	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Biblio/Biblio.bib	(revision 6440)
@@ -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}
 }
@@ -459,4 +472,16 @@
 }
 
+@article{bouffard_Boegman_DAO2013,
+	author = {D. Bouffard and L. Boegman},
+	title = {A diapycnal diffusivity model for stratified environmental flows},
+	volume = {61-62},
+	issn = {03770265},
+	url = {http://dx.doi.org/10.1016/j.dynatmoce.2013.02.002},
+	doi = {10.1016/j.dynatmoce.2013.02.002},
+	journal = DAO,
+	year = {2013},
+	pages = {14--34},
+}
+
 @ARTICLE{Bougeault1989,
   author = {P. Bougeault and P. Lacarrere},
@@ -489,4 +514,27 @@
   volume = {28},  number = {8},
   pages = {1603--1606}
+}
+
+@article{Brankart_OM2013,
+author = "J.-M. Brankart",
+title = "Impact of uncertainties in the horizontal density gradient upon low resolution global ocean modelling ",
+journal = OM,
+year = "2013",
+volume = "66", pages = "64--76",
+issn = "1463-5003",
+doi = "http://dx.doi.org/10.1016/j.ocemod.2013.02.004",
+url = "http://www.sciencedirect.com/science/article/pii/S1463500313000309",
+}
+
+@Article{Brankart_al_GMD2015,
+AUTHOR = {Brankart, J.-M. and Candille, G. and Garnier, F. and Calone, C. and Melet, A. and Bouttier, P.-A. and Brasseur, P. and Verron, J.},
+TITLE = {A generic approach to explicit simulation of uncertainty in the NEMO ocean model},
+JOURNAL = {Geoscientific Model Development},
+VOLUME = {8},
+YEAR = {2015},
+NUMBER = {5},
+PAGES = {1285--1297},
+URL = {http://www.geosci-model-dev.net/8/1285/2015/},
+DOI = {10.5194/gmd-8-1285-2015}
 }
 
@@ -753,4 +801,16 @@
 }
 
+@article{de_lavergne_JPO2016_efficiency,
+	title = {The impact of a variable mixing efficiency on the abyssal overturning},
+	issn = {0022-3670},
+	url = {http://dx.doi.org//10.1175/JPO-D-14-0259.1},
+	doi = {10.1175/JPO-D-14-0259.1},
+	abstract = {In studies of ocean mixing, it is generally assumed that small-scale turbulent overturns lose 15-20 \% of their energy in eroding the background stratification. Accumulating evidence that this energy fraction, or mixing efficiency Rf, significantly varies depending on flow properties challenges this assumption, however. Here, we examine the implications of a varying mixing efficiency for ocean energetics and deep water mass transformation. Combining current parameterizations of internal wave-driven mixing with a recent model expressing Rf as a function of a turbulence intensity parameter Reb = εν/νN2, we show that accounting for reduced mixing efficiencies in regions of weak stratification or energetic turbulence (high Reb) strongly limits the ability of breaking internal waves to supply oceanic potential energy and drive abyssal upwelling. Moving from a fixed Rf = 1/6 to a variable efficiency Rf(Reb) causes Antarctic Bottom Water upwelling induced by locally-dissipating internal tides and lee waves to fall from 9 to 4 Sv, and the corresponding potential energy source to plunge from 97 to 44 GW. When adding the contribution of remotely-dissipating internal tides under idealized distributions of energy dissipation, the total rate of Antarctic Bottom Water upwelling is reduced by about a factor of 2, reaching 5-15 Sv compared to 10-33 Sv for a fixed efficiency. Our results suggest that distributed mixing, overflow-related boundary processes and geothermal heating are more effective in consuming abyssal waters than topographically-enhanced mixing by breaking internal waves. Our calculations also point to the importance of accurately constraining Rf(Reb) and including the effect in ocean models.},
+	journal = {Journal of Physical Oceanography},
+	author = {C. de Lavergne and G. Madec and J. Le Sommer and A. J. G. Nurser and A. C. Naveira Garabato },
+	year = {2016},
+	volume = {46},  pages = {663-–681}
+}
+
 @ARTICLE{Delecluse_Madec_Bk00,
   author = {P. Delecluse and G. Madec},
@@ -763,4 +823,12 @@
 }
 
+@PHDTHESIS{Demange_PhD2014,
+  author = {J. Demange},
+  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 +1051,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 +1127,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 = 	 {}
 }
 
@@ -1104,4 +1184,18 @@
 }
 
+@article{goff_JGR2010,
+	author = {J. A. Goff},
+	title = {Global prediction of abyssal hill root-mean-square heights from small-scale altimetric gravity variability},
+	issn = {2156-2202},
+	url = {http://dx.doi.org/10.1029/2010JB007867},
+	doi = {10.1029/2010JB007867},
+	abstract = {Abyssal hills, which are pervasive landforms on the seafloor of the Earth's oceans, represent a potential tectonic record of the history of mid-ocean ridge spreading. However, the most detailed global maps of the seafloor, derived from the satellite altimetry-based gravity field, cannot be used to deterministically characterize such small-scale ({\textless}10 km) morphology. Nevertheless, the small-scale variability of the gravity field can be related to the statistical properties of abyssal hill morphology using the upward continuation formulation. In this paper, I construct a global prediction of abyssal hill root-mean-square (rms) heights from the small-scale variability of the altimetric gravity field. The abyssal hill-related component of the gravity field is derived by first masking distinct features, such as seamounts, mid-ocean ridges, and continental margins, and then applying a newly designed adaptive directional filter algorithm to remove fracture zone/discontinuity fabric. A noise field is derived empirically by correlating the rms variability of the small-scale gravity field to the altimetric noise field in regions of very low relief, and the noise variance is subtracted from the small-scale gravity variance. Suites of synthetically derived, abyssal hill formed gravity fields are generated as a function of water depth, basement rms heights, and sediment thickness and used to predict abyssal hill seafloor rms heights from corrected small-scale gravity rms height. The resulting global prediction of abyssal hill rms heights is validated qualitatively by comparing against expected variations in abyssal hill morphology and quantitatively by comparing against actual measurements of rms heights. Although there is scatter, the prediction appears unbiased.},
+	volume = {115},
+	number = {B12},
+	journal = {Journal of Geophysical Research: Solid Earth},
+	year = {2010},
+	pages = {B12104},
+}
+
 @ARTICLE{Goosse_al_JGR99,
   author = {H. Goosse and E. Deleersnijder and T. Fichefet and M. England},
@@ -1122,4 +1216,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}
 }
 
@@ -1197,4 +1301,14 @@
 }
 
+@ARTICLE{Griffies_Hallberg_MWR00,
+  author = {S.M. Griffies and R.H. Hallberg},
+  title = {Biharmonic friction with a Smagorinsky-like viscosity for use in large-scale eddy-permitting ocean models},
+  journal = MWR,
+  year = {2000},
+  volume = {128},  
+  pages = {2935–-2946},
+ url = {http://dx.doi.org/10.1175/1520-0493(2000)128}
+}
+
 @ARTICLE{Guilyardi_al_JC04,
   author = {E. Guilyardi and S. Gualdi and J. M. Slingo and A. Navarra and P. Delecluse 
@@ -1347,4 +1461,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 +1553,21 @@
 }
 
+@TechReport{Hunter2006,
+  Title                    = {Specification for Test Models of Ice Shelf Cavities},
+  Author                   = {J. R. Hunter},
+  Institution              = {Antarctic Climate \& Ecosystems Cooperative Research Centre Private Bag 80, Hobart, Tasmania 7001},
+  Year                     = {2006},
+}
+
+@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},
@@ -1486,4 +1626,17 @@
 }
 
+@article{Jackson_Rehmann_JPO2014,
+	author = {P. R. Jackson and C. R. Rehmann},
+	title = {Experiments on differential scalar mixing in turbulence in a sheared, stratified flow},
+	journal = JPO,
+	volume = {44},
+	issn = {0022-3670},
+	url = {http://dx.doi.org/10.1175/JPO-D-14-0027.1},
+	doi = {10.1175/JPO-D-14-0027.1},
+	number = {10},
+	year = {2014},
+	pages = {2661--2680},
+}
+
 @ARTICLE{Jayne_St_Laurent_GRL01,
   author = {S.R. Jayne and L.C. {St. Laurent}},
@@ -1491,4 +1644,31 @@
   journal = GRL,
   pages = {811--814}
+}
+
+@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{Jenkins2001,
+  author = {A. Jenkins},
+  title = {The Role of Meltwater Advection in the Formulation of Conservative Boundary Conditions at an Ice-Ocean Interface},
+  journal = JPO,
+  year = {2001},
+  volume = {31},
+  pages = {285--296}
+}
+
+@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}
 }
 
@@ -1643,4 +1823,28 @@
 }
 
+@article{Lemarie_OM2012,
+author = "F. Lemari\'{e} and L. Debreu and A.F. Shchepetkin and J.C. McWilliams",
+title = "On the stability and accuracy of the harmonic and biharmonic isoneutral mixing operators in ocean models ",
+journal = OM,
+year = "2012",
+volume = "52–53", pages = "9--35",
+issn = "1463-5003",
+doi = "http://dx.doi.org/10.1016/j.ocemod.2012.04.007",
+url = "http://www.sciencedirect.com/science/article/pii/S1463500312000674",
+}
+
+
+@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 +1859,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}
@@ -1783,15 +1987,25 @@
   year = {2009},
   volume = {30},  number = {2-3},
-  pages = {88-94},
+  pages = {88--94},
   doi = {10.1016/j.ocemod.2009.06.006},
-  url = {http://dx.doi.org/}
-}
-
-@ARTICLE{Leclair_Madec_OM10s,
+  url = {http://dx.doi.org/10.1016/j.ocemod.2009.06.006}
+}
+
+@ARTICLE{Leclair_Madec_OM11,
   author = {M. Leclair and G. Madec},
   title = {$\tilde{z}$-coordinate, an Arbitrary Lagrangian-Eulerian coordinate separating high and low frequency},
   journal = OM,
-  year = {2010},
-  pages = {submitted},
+  year = {2011},
+  volume = {37},  pages = {139--152}, 
+  doi = {10.1016/j.ocemod.2011.02.001},
+  url = {http://dx.doi.org/10.1016/j.ocemod.2011.02.001}
+}
+
+@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}
 }
 
@@ -1803,6 +2017,5 @@
   journal = JC,
   year = {2003},
-  volume = {16},  number = {20},
-  pages = {3330--3343}
+  volume = {16},  number = {20}, pages = {3330--3343}
 }
 
@@ -1900,4 +2113,12 @@
 }
 
+@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},
+}
+
 @TECHREPORT{Lott1989,
   author = {F. Lott and G. Madec},
@@ -2074,17 +2295,4 @@
   volume = {3},
   pages = {1--20}
-}
-
-
-@article{Martin_Adcroft_OM10,
-author = {T. Martin and A. Adcroft},
-title = {Parameterizing the fresh-water flux from land ice to ocean with interactive icebergs in a coupled climate model},
-journal = OM,
-year = {2010},
-volume = {34}, number = {3--4},
-pages = {111--124},
-issn = {1463-5003},
-doi = {10.1016/j.ocemod.2010.05.001},
-url = {http://dx.doi.org/10.1016/j.ocemod.2010.05.001}
 }
 
@@ -2100,4 +2308,28 @@
   doi = {10.1016/j.ocemod.2007.07.005},
   url = {http://dx.doi.org/10.1016/j.ocemod.2007.07.005}
+}
+
+@Article{Marsh_GMD2015,
+AUTHOR = {R. Marsh and V. O. Ivchenko and N. Skliris and S. Alderson and G. R. Bigg and G. Madec and A. T. Blaker and Y. Aksenov and B. Sinha and A. C. Coward and J. Le Sommer and N. Merino and V. B. Zalesny},
+TITLE = {NEMO-ICB (v1.0): interactive icebergs in the NEMO ocean model globally configured at eddy-permitting resolution},
+JOURNAL = {Geoscientific Model Development},
+VOLUME = {8},
+YEAR = {2015},
+NUMBER = {5},
+PAGES = {1547--1562},
+url = {HTTP://www.geosci-model-dev.net/8/1547/2015/},
+DOI = {10.5194/gmd-8-1547-2015}
+}
+
+@article{Martin_Adcroft_OM10,
+author = {T. Martin and A. Adcroft},
+title = {Parameterizing the fresh-water flux from land ice to ocean with interactive icebergs in a coupled climate model},
+journal = OM,
+year = {2010},
+volume = {34}, number = {3--4},
+pages = {111--124},
+issn = {1463-5003},
+doi = {10.1016/j.ocemod.2010.05.001},
+url = {http://dx.doi.org/10.1016/j.ocemod.2010.05.001}
 }
 
@@ -2249,4 +2481,15 @@
 }
 
+
+@ARTICLE{Morel_Berthon_LO89,
+  author = {A. Morel and J.-F. Berthon},
+  title = {Surface pigments, algal biomass profiles, and potential production of the euphotic layer: 
+           Relationships reinvestigated in view of remote-sensing applications},
+  journal = {Limnol. Oceanogr.},
+  year = {1989},
+  volume = {34(8)},
+  pages = {1545--1562}
+}
+
 @ARTICLE{Morel_Maritorena_JGR01,
   author = {A. Morel and S. Maritorena},
@@ -2297,4 +2540,5 @@
   title = {Estimates of the local rate of vertical diﬀusion from dissipation measurements},
   journal = JPO,
+  year = {1980},
   volume = {10},
   pages = {83--89}
@@ -2470,4 +2714,16 @@
 }
 
+@Article{Rodgers_2014,
+AUTHOR = {Rodgers, K. B. and Aumont, O. and Mikaloff Fletcher, S. E. and Plancherel, Y. and Bopp, L. and de Boyer Mont\'egut, C. and Iudicone, D. and Keeling, R. F. and Madec, G. and Wanninkhof, R.},
+TITLE = {Strong sensitivity of Southern Ocean carbon uptake and nutrient cycling to wind stirring},
+JOURNAL = {Biogeosciences},
+VOLUME = {11},
+YEAR = {2014},
+NUMBER = {15},
+PAGES = {4077--4098},
+URL = {HTTP://www.biogeosciences.net/11/4077/2014/},
+DOI = {10.5194/bg-11-4077-2014}
+}
+
 @ARTICLE{Rodi_1987,
   author = {W. Rodi},
@@ -2486,4 +2742,27 @@
   year = {1986},
   editor = {J.J. O'Brien}
+}
+
+@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"
 }
 
@@ -2498,4 +2777,15 @@
 }
 
+@ARTICLE{Rousset_GMD2015,
+  author = {C. Rousset and M. Vancoppenolle and G. Madec and T. Fichefet and S. Flavoni 
+            and A. Barth\'{e}lemy and R. Benshila and J. Chanut and C. L\'{e}vy and S. Masson and F. Vivier },
+  title  = {The Louvain-La-Neuve sea-ice model LIM3.6: Global and regional capabilities},
+  journal= {Geoscientific Model Development},
+  year = {2015},
+  volume = {8}, pages={2991--3005},
+  doi = {10.5194/gmd-8-2991-2015},
+  url = {http://dx.doi.org/10.5194/gmd-8-2991-2015}
+}
+
 @ARTICLE{Sadourny1975,
   author = {R. Sadourny},
@@ -2514,4 +2804,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},
 }
 
@@ -2570,4 +2870,13 @@
 }
 
+@INBOOK{Smagorinsky_93,
+  author = {Smagorinsky, J.},
+  chapter = {Some historical remarks on the use of non-linear viscosities},
+  title = {Large Eddy Simulation of Complex Engineering and Geophysical Flows},
+  pages = {3--36},
+  year = {1993},
+  publisher = {Cambridge University Press, B. Galperin and S. A. Orszag (eds.)},
+}
+
 @ARTICLE{Song_Haidvogel_JCP94,
   author = {Y. Song and D. Haidvogel},
@@ -2688,4 +2997,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 +3113,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 +3172,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/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Abstracts_Foreword.tex
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Abstracts_Foreword.tex	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Abstracts_Foreword.tex	(revision 6440)
@@ -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{Absolute} 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 Temp\'{e}rature 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/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Annex_C.tex
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Annex_C.tex	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Annex_C.tex	(revision 6440)
@@ -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: 
@@ -1103,5 +1103,5 @@
 The discrete formulation of the horizontal diffusion of momentum ensures the 
 conservation of potential vorticity and the horizontal divergence, and the 
-dissipation of the square of these quantities (i.e. enstrophy and the 
+dissipation of the square of these quantities ($i.e.$ enstrophy and the 
 variance of the horizontal divergence) as well as the dissipation of the 
 horizontal kinetic energy. In particular, when the eddy coefficients are 
@@ -1127,26 +1127,17 @@
 &\int \limits_D \frac{1} {e_3 } \textbf{k} \cdot \nabla \times 
 	\Bigl[    \nabla_h  \left( A^{\,lm}\;\chi  \right)
-	          - \nabla_h \times \left( A^{\,lm}\;\zeta \; \textbf{k} \right)    \Bigr]\;dv  = 0
-\end{flalign*}
+	        - \nabla_h \times \left( A^{\,lm}\;\zeta \; \textbf{k} \right)    \Bigr]\;dv   \\ 
+%\end{flalign*}
 %%%%%%%%%%  recheck here....  (gm)
-\begin{flalign*}
-= \int \limits_D  -\frac{1} {e_3 } \textbf{k} \cdot \nabla \times 
-	\Bigl[ \nabla_h \times \left( A^{\,lm}\;\zeta \; \textbf{k} \right)  \Bigr]\;dv &&& \\ 
-\end{flalign*}
-\begin{flalign*}
+%\begin{flalign*}
+=& \int \limits_D  -\frac{1} {e_3 } \textbf{k} \cdot \nabla \times 
+	\Bigl[ \nabla_h \times \left( A^{\,lm}\;\zeta \; \textbf{k} \right)  \Bigr]\;dv  \\ 
+%\end{flalign*}
+%\begin{flalign*}
 \equiv& \sum\limits_{i,j}
 	\left\{
-	\delta_{i+1/2} 
-	\left[ 
-	\frac {e_{2v}} {e_{1v}\,e_{3v}}  \delta_i
-		\left[ A_f^{\,lm} e_{3f} \zeta  \right]
-	 \right]
- 	+ \delta_{j+1/2} 
-	\left[ 
-	\frac {e_{1u}} {e_{2u}\,e_{3u}} \delta_j 
-		\left[ A_f^{\,lm} e_{3f} \zeta  \right]
-	\right]
-	\right\} 
-	&& \\ 
+	  \delta_{i+1/2} \left[  \frac {e_{2v}} {e_{1v}\,e_{3v}}  \delta_i \left[ A_f^{\,lm} e_{3f} \zeta  \right]  \right]
+ 	+ \delta_{j+1/2} \left[  \frac {e_{1u}} {e_{2u}\,e_{3u}}  \delta_j \left[ A_f^{\,lm} e_{3f} \zeta  \right]  \right]
+	\right\} 	 \\ 
 %
 \intertext{Using \eqref{DOM_di_adj}, it follows:}
@@ -1154,10 +1145,8 @@
 \equiv& \sum\limits_{i,j,k} 
 	-\,\left\{
-	   \frac{e_{2v}} {e_{1v}\,e_{3v}}  \delta_i
-		\left[ A_f^{\,lm} e_{3f} \zeta  \right]\;\delta_i \left[ 1\right]
-	+ \frac{e_{1u}} {e_{2u}\,e_{3u}} \delta_j 
-		\left[ A_f^{\,lm} e_{3f} \zeta  \right]\;\delta_j \left[ 1\right]
+	   \frac{e_{2v}} {e_{1v}\,e_{3v}}  \delta_i	\left[ A_f^{\,lm} e_{3f} \zeta  \right]\;\delta_i \left[ 1\right]
+	 + \frac{e_{1u}} {e_{2u}\,e_{3u}}  \delta_j 	\left[ A_f^{\,lm} e_{3f} \zeta  \right]\;\delta_j \left[ 1\right]
 	\right\} \quad \equiv 0 
-	&& \\ 
+	 \\ 
 \end{flalign*}
 
@@ -1167,5 +1156,4 @@
 \subsection{Dissipation of Horizontal Kinetic Energy}
 \label{Apdx_C.3.2}
-
 
 The lateral momentum diffusion term dissipates the horizontal kinetic energy:
@@ -1221,5 +1209,4 @@
 \label{Apdx_C.3.3}
 
-
 The lateral momentum diffusion term dissipates the enstrophy when the eddy 
 coefficients are horizontally uniform:
@@ -1228,7 +1215,7 @@
 	\left[   \nabla_h \left( A^{\,lm}\;\chi  \right)
 	       - \nabla_h \times \left( A^{\,lm}\;\zeta \; \textbf{k} \right)   \right]\;dv &&&\\
-&= A^{\,lm} \int \limits_D \zeta \textbf{k} \cdot \nabla \times 
+&\quad = A^{\,lm} \int \limits_D \zeta \textbf{k} \cdot \nabla \times 
  	\left[    \nabla_h \times \left( \zeta \; \textbf{k} \right)   \right]\;dv &&&\\
-&\equiv A^{\,lm} \sum\limits_{i,j,k}  \zeta \;e_{3f} 
+&\quad \equiv A^{\,lm} \sum\limits_{i,j,k}  \zeta \;e_{3f} 
 	\left\{     \delta_{i+1/2} \left[  \frac{e_{2v}} {e_{1v}\,e_{3v}} \delta_i \left[ e_{3f} \zeta  \right]   \right]
 	          + \delta_{j+1/2} \left[  \frac{e_{1u}} {e_{2u}\,e_{3u}} \delta_j \left[ e_{3f} \zeta  \right]   \right]      \right\}   &&&\\ 
@@ -1236,8 +1223,7 @@
 \intertext{Using \eqref{DOM_di_adj}, it follows:}
 %
-&\equiv  - A^{\,lm} \sum\limits_{i,j,k} 
+&\quad \equiv  - A^{\,lm} \sum\limits_{i,j,k} 
 	\left\{    \left(  \frac{1} {e_{1v}\,e_{3v}}  \delta_i \left[ e_{3f} \zeta  \right]  \right)^2   b_v
-	         + \left(  \frac{1} {e_{2u}\,e_{3u}}  \delta_j \left[ e_{3f} \zeta  \right] \right)^2   b_u  \right\}      &&&\\
-& \leq \;0       &&&\\ 
+	         + \left(  \frac{1} {e_{2u}\,e_{3u}}  \delta_j \left[ e_{3f} \zeta  \right] \right)^2   b_u  \right\}  \quad \leq \;0    &&&\\
 \end{flalign*}
 
@@ -1250,16 +1236,16 @@
 When the horizontal divergence of the horizontal diffusion of momentum 
 (discrete sense) is taken, the term associated with the vertical curl of the 
-vorticity is zero locally, due to (!!! II.1.8  !!!!!). The resulting term conserves the 
-$\chi$ and dissipates $\chi^2$ when the eddy coefficients are 
-horizontally uniform.
+vorticity is zero locally, due to \eqref{Eq_DOM_div_curl}. 
+The resulting term conserves the $\chi$ and dissipates $\chi^2$ 
+when the eddy coefficients are horizontally uniform.
 \begin{flalign*}
 & \int\limits_D  \nabla_h \cdot 
 	\Bigl[     \nabla_h \left( A^{\,lm}\;\chi \right)
 	          - \nabla_h \times \left( A^{\,lm}\;\zeta \;\textbf{k} \right)    \Bigr]  dv
-= \int\limits_D  \nabla_h \cdot \nabla_h \left( A^{\,lm}\;\chi  \right)   dv   &&&\\
+= \int\limits_D  \nabla_h \cdot \nabla_h \left( A^{\,lm}\;\chi  \right)   dv   \\
 %
 &\equiv \sum\limits_{i,j,k} 
 	\left\{   \delta_i \left[ A_u^{\,lm} \frac{e_{2u}\,e_{3u}} {e_{1u}}  \delta_{i+1/2} \left[ \chi \right]  \right]
-	        + \delta_j \left[ A_v^{\,lm} \frac{e_{1v}\,e_{3v}} {e_{2v}}  \delta_{j+1/2} \left[ \chi \right]  \right]    \right\}    &&&\\ 
+	        + \delta_j \left[ A_v^{\,lm} \frac{e_{1v}\,e_{3v}} {e_{2v}}  \delta_{j+1/2} \left[ \chi \right]  \right]    \right\}    \\ 
 %
 \intertext{Using \eqref{DOM_di_adj}, it follows:}
@@ -1267,6 +1253,6 @@
 &\equiv \sum\limits_{i,j,k} 
 	- \left\{   \frac{e_{2u}\,e_{3u}} {e_{1u}}  A_u^{\,lm} \delta_{i+1/2} \left[ \chi \right] \delta_{i+1/2} \left[ 1 \right] 
-	          + \frac{e_{1v}\,e_{3v}}  {e_{2v}}  A_v^{\,lm} \delta_{j+1/2} \left[ \chi \right] \delta_{j+1/2} \left[ 1 \right]    \right\} 
-	\qquad \equiv 0     &&& \\ 
+	          + \frac{e_{1v}\,e_{3v}} {e_{2v}}  A_v^{\,lm} \delta_{j+1/2} \left[ \chi \right] \delta_{j+1/2} \left[ 1 \right]    \right\} 
+	\quad \equiv 0      \\ 
 \end{flalign*}
 
@@ -1281,5 +1267,5 @@
 	\left[    \nabla_h              \left( A^{\,lm}\;\chi                    \right)
 	        - \nabla_h   \times  \left( A^{\,lm}\;\zeta \;\textbf{k} \right)    \right]\;  dv
- = A^{\,lm}   \int\limits_D \chi \;\nabla_h \cdot \nabla_h \left( \chi \right)\;  dv    &&&\\ 
+ = A^{\,lm}   \int\limits_D \chi \;\nabla_h \cdot \nabla_h \left( \chi \right)\;  dv    \\ 
 %
 &\equiv A^{\,lm}  \sum\limits_{i,j,k}  \frac{1} {e_{1t}\,e_{2t}\,e_{3t}}  \chi 
@@ -1287,5 +1273,5 @@
 	   \delta_i  \left[   \frac{e_{2u}\,e_{3u}} {e_{1u}}  \delta_{i+1/2} \left[ \chi \right]   \right]
 	+ \delta_j  \left[   \frac{e_{1v}\,e_{3v}} {e_{2v}}   \delta_{j+1/2} \left[ \chi \right]   \right]
-	\right\} \;   e_{1t}\,e_{2t}\,e_{3t}    &&&\\ 
+	\right\} \;   e_{1t}\,e_{2t}\,e_{3t}    \\ 
 %
 \intertext{Using \eqref{DOM_di_adj}, it turns out to be:}
@@ -1293,7 +1279,6 @@
 &\equiv - A^{\,lm} \sum\limits_{i,j,k}
 	\left\{    \left(  \frac{1} {e_{1u}}  \delta_{i+1/2}  \left[ \chi \right]  \right)^2  b_u
-                 + \left(  \frac{1} {e_{2v}}  \delta_{j+1/2}  \left[ \chi \right]  \right)^2  b_v    \right\} \;    &&&\\
-%
-&\leq 0              &&&\\
+            + \left(  \frac{1} {e_{2v}}  \delta_{j+1/2}  \left[ \chi \right]  \right)^2  b_v    \right\}    
+\quad \leq 0             \\
 \end{flalign*}
 
@@ -1303,5 +1288,4 @@
 \section{Conservation Properties on Vertical Momentum Physics}
 \label{Apdx_C_4}
-
 
 As for the lateral momentum physics, the continuous form of the vertical diffusion 
@@ -1319,6 +1303,6 @@
 	\left(   \frac{A^{\,vm}} {e_3 }\; \frac{\partial \textbf{U}_h } {\partial k}   \right)\; dv    \quad &\leq 0     \\
 \end{align*}
+
 The first property is obvious. The second results from:
-
 \begin{flalign*}
 \int\limits_D 
@@ -1359,4 +1343,5 @@
 	e_{1f}\,e_{2f}\,e_{3f} \; \equiv 0   && \\
 \end{flalign*}
+
 If the vertical diffusion coefficient is uniform over the whole domain, the 
 enstrophy is dissipated, $i.e.$
@@ -1366,6 +1351,6 @@
 		\left( \frac{A^{\,vm}} {e_3 }\; \frac{\partial \textbf{U}_h } {\partial k}   \right)   \right)\; dv = 0   &&&\\
 \end{flalign*}
+
 This property is only satisfied in $z$-coordinates:
-
 \begin{flalign*}
 \int\limits_D \zeta \, \textbf{k} \cdot \nabla \times 
@@ -1477,10 +1462,8 @@
 
 The numerical schemes used for tracer subgridscale physics are written such 
-that the heat and salt contents are conserved (equations in flux form, second 
-order centered finite differences). Since a flux form is used to compute the 
-temperature and salinity, the quadratic form of these quantities (i.e. their variance) 
-globally tends to diminish. As for the advection term, there is generally no strict 
-conservation of mass, even if in practice the mass is conserved to a very high 
-accuracy. 
+that the heat and salt contents are conserved (equations in flux form). 
+Since a flux form is used to compute the temperature and salinity, 
+the quadratic form of these quantities ($i.e.$ their variance) globally tends to diminish. 
+As for the advection term, there is conservation of mass only if the Equation Of Seawater is linear. 
 
 % -------------------------------------------------------------------------------------------------------------
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Annex_D.tex
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Annex_D.tex	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Annex_D.tex	(revision 6440)
@@ -120,5 +120,5 @@
 \hline
 public  \par or  \par module variable& 
-\textbf{m n} \par \textit{but not} \par \textbf{nn\_}& 
+\textbf{m n} \par \textit{but not} \par \textbf{nn\_ np\_}& 
 \textbf{a b e f g h o q r} \par \textbf{t} \textit{to} \textbf{x} \par but not \par \textbf{fs rn\_}& 
 \textbf{l} \par \textit{but not} \par \textbf{lp ld} \par \textbf{ ll ln\_}& 
@@ -156,5 +156,5 @@
 \hline
 parameter& 
-\textbf{jp}& 
+\textbf{jp np\_}& 
 \textbf{pp}& 
 \textbf{lp}& 
@@ -190,4 +190,8 @@
 %--------------------------------------------------------------------------------------------------------------
 
+N.B.   Parameter here, in not only parameter in the \textsc{Fortran} acceptation, it is also used for code variables 
+that are read in namelist and should never been modified during a simulation. 
+It is the case, for example, for the size of a domain (jpi,jpj,jpk).
+
 \newpage
 % ================================================================
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_DIA.tex
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_DIA.tex	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_DIA.tex	(revision 6440)
@@ -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
 
 % ================================================================
@@ -48,5 +48,7 @@
 
 
-Since version 3.2, iomput is the NEMO output interface of choice. It has been designed to be simple to use, flexible and efficient. The two main purposes of iomput are: 
+Since version 3.2, iomput is the NEMO output interface of choice. 
+It has been designed to be simple to use, flexible and efficient. 
+The two main purposes of iomput are: 
 \begin{enumerate}
 \item The complete and flexible control of the output files through external XML files adapted by the user from standard templates. 
@@ -1116,6 +1118,5 @@
 % -------------------------------------------------------------------------------------------------------------
 \section[Tracer/Dynamics Trends (TRD)]
-                  {Tracer/Dynamics Trends  (\key{trdtra}, \key{trddyn},    \\ 
-                                                             \key{trddvor}, \key{trdmld})}
+                  {Tracer/Dynamics Trends  (\ngn{namtrd})}
 \label{DIA_trd}
 
@@ -1124,40 +1125,33 @@
 %-------------------------------------------------------------------------------------------------------------
 
-When \key{trddyn} and/or \key{trddyn} CPP variables are defined, each 
-trend of the dynamics and/or temperature and salinity time evolution equations 
-is stored in three-dimensional arrays just after their computation ($i.e.$ at the end 
-of each $dyn\cdots.F90$ and/or $tra\cdots.F90$ routines). Options are defined by
-\ngn{namtrd} namelist variables. These trends are then 
-used in \mdl{trdmod} (see TRD directory) every \textit{nn\_trd } time-steps.
-
-What is done depends on the CPP keys defined:
+Each trend of the dynamics and/or temperature and salinity time evolution equations 
+can be send to \mdl{trddyn} and/or \mdl{trdtra} modules (see TRD directory) just after their computation 
+($i.e.$ at the end of each $dyn\cdots.F90$ and/or $tra\cdots.F90$ routines). 
+This capability is controlled by options offered in \ngn{namtrd} namelist. 
+Note that the output are done with xIOS, and therefore the \key{IOM} is required.
+
+What is done depends on the \ngn{namtrd} logical set to \textit{true}:
 \begin{description}
-\item[\key{trddyn}, \key{trdtra}] : a check of the basin averaged properties of the momentum 
-and/or tracer equations is performed ; 
-\item[\key{trdvor}] : a vertical summation of the moment tendencies is performed, 
-then the curl is computed to obtain the barotropic vorticity tendencies which are output ;
-\item[\key{trdmld}] : output of the tracer tendencies averaged vertically  
-either over the mixed layer (\np{nn\_ctls}=0), 
-or       over a fixed number of model levels (\np{nn\_ctls}$>$1 provides the number of level), 
-or       over a spatially varying but temporally fixed number of levels (typically the base 
-of the winter mixed layer) read in \ifile{ctlsurf\_idx} (\np{nn\_ctls}=1) ;
+\item[\np{ln\_glo\_trd}] : at each \np{nn\_trd} time-step a check of the basin averaged properties 
+of the momentum and tracer equations is performed. This also includes a check of $T^2$, $S^2$, 
+$\tfrac{1}{2} (u^2+v2)$, and potential energy time evolution equations properties ; 
+\item[\np{ln\_dyn\_trd}] : each 3D trend of the evolution of the two momentum components is output ; 
+\item[\np{ln\_dyn\_mxl}] : each 3D trend of the evolution of the two momentum components averaged 
+                           over the mixed layer is output  ; 
+\item[\np{ln\_vor\_trd}] : a vertical summation of the moment tendencies is performed, 
+                           then the curl is computed to obtain the barotropic vorticity tendencies which are output ;
+\item[\np{ln\_KE\_trd}]  : each 3D trend of the Kinetic Energy equation is output ;
+\item[\np{ln\_tra\_trd}] : each 3D trend of the evolution of temperature and salinity is output ;
+\item[\np{ln\_tra\_mxl}] : each 2D trend of the evolution of temperature and salinity averaged 
+                           over the mixed layer is output ;
 \end{description}
-
-The units in the output file can be changed using the \np{nn\_ucf} namelist parameter. 
-For example, in case of salinity tendency the units are given by PSU/s/\np{nn\_ucf}.
-Setting \np{nn\_ucf}=86400 ($i.e.$ the number of second in a day) provides the tendencies in PSU/d.
-
-When \key{trdmld} is defined, two time averaging procedure are proposed.
-Setting \np{ln\_trdmld\_instant} to \textit{true}, a simple time averaging is performed, 
-so that the resulting tendency is the contribution to the change of a quantity between 
-the two instantaneous values taken at the extremities of the time averaging period.
-Setting \np{ln\_trdmld\_instant} to \textit{false}, a double time averaging is performed, 
-so that the resulting tendency is the contribution to the change of a quantity between 
-two \textit{time mean} values. The later option requires the use of an extra file, \ifile{restart\_mld}  
-(\np{ln\_trdmld\_restart}=true), to restart a run.
-
 
 Note that the mixed layer tendency diagnostic can also be used on biogeochemical models 
 via the \key{trdtrc} and \key{trdmld\_trc} CPP keys.
+
+\textbf{Note that} in the current version (v3.6), many changes has been introduced but not fully tested. 
+In particular, options associated with \np{ln\_dyn\_mxl}, \np{ln\_vor\_trd}, and \np{ln\_tra\_mxl} 
+are not working, and none of the option have been tested with variable volume ($i.e.$ \key{vvl} defined).
+
 
 % -------------------------------------------------------------------------------------------------------------
@@ -1280,28 +1274,26 @@
 \label{DIA_diag_harm}
 
-A module is available to compute the amplitude and phase for tidal waves. 
-This diagnostic is actived with \key{diaharm}.
-
 %------------------------------------------namdia_harm----------------------------------------------------
 \namdisplay{namdia_harm}
 %----------------------------------------------------------------------------------------------------------
 
-Concerning the on-line Harmonic analysis, some parameters are available in namelist
-\ngn{namdia\_harm} :
-
-- \texttt{nit000\_han} is the first time step used for harmonic analysis
-
-- \texttt{nitend\_han} is the last time step used for harmonic analysis
-
-- \texttt{nstep\_han} is the time step frequency for harmonic analysis
-
-- \texttt{nb\_ana} is the number of harmonics to analyse
-
-- \texttt{tname} is an array with names of tidal constituents to analyse
-
-\texttt{nit000\_han} and \texttt{nitend\_han} must be between \texttt{nit000} and \texttt{nitend} of the simulation.
+A module is available to compute the amplitude and phase of tidal waves. 
+This on-line Harmonic analysis is actived with \key{diaharm}.
+Some parameters are available in namelist \ngn{namdia\_harm} :
+
+- \np{nit000\_han} is the first time step used for harmonic analysis
+
+- \np{nitend\_han} is the last time step used for harmonic analysis
+
+- \np{nstep\_han} is the time step frequency for harmonic analysis
+
+- \np{nb\_ana} is the number of harmonics to analyse
+
+- \np{tname} is an array with names of tidal constituents to analyse
+
+\np{nit000\_han} and \np{nitend\_han} must be between \np{nit000} and \np{nitend} of the simulation.
 The restart capability is not implemented.
 
-The Harmonic analysis solve this equation:
+The Harmonic analysis solve the following equation:
 \begin{equation}
 h_{i} - A_{0} + \sum^{nb\_ana}_{j=1}[A_{j}cos(\nu_{j}t_{j}-\phi_{j})] = e_{i}
@@ -1324,6 +1316,6 @@
 \label{DIA_diag_dct}
 
-A module is available to compute the transport of volume, heat and salt through sections. This diagnostic
-is actived with \key{diadct}.
+A module is available to compute the transport of volume, heat and salt through sections. 
+This diagnostic is actived with \key{diadct}.
 
 Each section is defined by the coordinates of its 2 extremities. The pathways between them are contructed
@@ -1347,9 +1339,9 @@
 %-------------------------------------------------------------------------------------------------------------
 
-\texttt{nn\_dct}: frequency of instantaneous transports computing
-
-\texttt{nn\_dctwri}: frequency of writing ( mean of instantaneous transports )
-
-\texttt{nn\_debug}: debugging of the section
+\np{nn\_dct}: frequency of instantaneous transports computing
+
+\np{nn\_dctwri}: frequency of writing ( mean of instantaneous transports )
+
+\np{nn\_debug}: debugging of the section
 
 \subsubsection{ To create a binary file containing the pathway of each section }
@@ -1482,5 +1474,5 @@
 the \key{diahth} CPP key: 
 
-- the mixed layer depth (based on a density criterion, \citet{de_Boyer_Montegut_al_JGR04}) (\mdl{diahth})
+- the mixed layer depth (based on a density criterion \citep{de_Boyer_Montegut_al_JGR04}) (\mdl{diahth})
 
 - the turbocline depth (based on a turbulent mixing coefficient criterion) (\mdl{diahth})
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_DOM.tex
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_DOM.tex	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_DOM.tex	(revision 6440)
@@ -1,4 +1,4 @@
 % ================================================================
-% Chapter 2 � Space and Time Domain (DOM)
+% Chapter 2 ——— Space and Time Domain (DOM)
 % ================================================================
 \chapter{Space Domain (DOM) }
@@ -138,5 +138,5 @@
 and $f$-points, and its divergence defined at $t$-points:
 \begin{eqnarray}  \label{Eq_DOM_curl}
- \nabla \times {\rm {\bf A}}\equiv &
+ \nabla \times {\rm{\bf A}}\equiv &
       \frac{1}{e_{2v}\,e_{3vw} } \ \left( \delta_{j +1/2} \left[e_{3w}\,a_3 \right] -\delta_{k+1/2} \left[e_{2v} \,a_2 \right] \right)  &\ \mathbf{i} \\ 
  +& \frac{1}{e_{2u}\,e_{3uw}} \ \left( \delta_{k+1/2} \left[e_{1u}\,a_1  \right] -\delta_{i +1/2} \left[e_{3w}\,a_3 \right] \right)  &\ \mathbf{j} \\
@@ -183,6 +183,6 @@
 Let $a$ and $b$ be two fields defined on the mesh, with value zero inside 
 continental area. Using integration by parts it can be shown that the differencing 
-operators ($\delta_i$, $\delta_j$ and $\delta_k$) are anti-symmetric linear 
-operators, and further that the averaging operators $\overline{\,\cdot\,}^{\,i}$, 
+operators ($\delta_i$, $\delta_j$ and $\delta_k$) are skew-symmetric linear operators, 
+and further that the averaging operators $\overline{\,\cdot\,}^{\,i}$, 
 $\overline{\,\cdot\,}^{\,k}$ and $\overline{\,\cdot\,}^{\,k}$) are symmetric linear 
 operators, $i.e.$
@@ -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$. }
@@ -425,5 +425,5 @@
 
 The choice of the grid must be consistent with the boundary conditions specified 
-by the parameter \np{jperio} (see {\S\ref{LBC}).
+by \np{jperio}, a parameter found in \ngn{namcfg} namelist (see {\S\ref{LBC}).
 
 % -------------------------------------------------------------------------------------------------------------
@@ -481,5 +481,5 @@
 %>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 
-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 
@@ -494,9 +494,10 @@
 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).
+(\np{ln\_zps}~=~true), ocean cavity beneath ice shelves can be open (\np{ln\_isfcav}~=~true) 
+and partial step are also applied at the ocean/ice shelf interface. 
 
 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 
@@ -540,5 +541,5 @@
 
 Three options are possible for defining the bathymetry, according to the 
-namelist variable \np{nn\_bathy}: 
+namelist variable \np{nn\_bathy} (found in \ngn{namdom} namelist): 
 \begin{description}
 \item[\np{nn\_bathy} = 0] a flat-bottom domain is defined. The total depth $z_w (jpk)$ 
@@ -548,10 +549,14 @@
 domain width at the central latitude. This is meant for the "EEL-R5" configuration, 
 a periodic or open boundary channel with a seamount. 
-\item[\np{nn\_bathy} = 1] read a bathymetry. The \ifile{bathy\_meter} file (Netcdf format) 
-provides the ocean depth (positive, in meters) at each grid point of the model grid. 
-The bathymetry is usually built by interpolating a standard bathymetry product 
+\item[\np{nn\_bathy} = 1] read a bathymetry and ice shelf draft (if needed).
+ The \ifile{bathy\_meter} file (Netcdf format) provides the ocean depth (positive, in meters)
+ at each grid point of the model grid. The bathymetry is usually built by interpolating a standard bathymetry product 
 ($e.g.$ ETOPO2) onto the horizontal ocean mesh. Defining the bathymetry also 
 defines the coastline: where the bathymetry is zero, no model levels are defined 
 (all levels are masked).
+
+The \ifile{isfdraft\_meter} file (Netcdf format) provides the ice shelf draft (positive, in meters)
+ at each grid point of the model grid. This file is only needed if \np{ln\_isfcav}~=~true. 
+Defining the ice shelf draft will also define the ice shelf edge and the grounding line position.
 \end{description}
 
@@ -610,4 +615,16 @@
 (Fig.~\ref{Fig_zgr}).
 
+If the ice shelf cavities are opened (\np{ln\_isfcav}=~true~}), the definition of $z_0$ is the same. 
+However, definition of $e_3^0$ at $t$- and $w$-points is respectively changed to:
+\begin{equation} \label{DOM_zgr_ana}
+\begin{split}
+ e_3^T(k) &= z_W (k+1) - z_W (k)   \\
+ e_3^W(k) &= z_T (k)   - z_T (k-1) \\
+\end{split}
+\end{equation}
+This formulation decrease the self-generated circulation into the ice shelf cavity 
+(which can, in extreme case, leads to blow up).\\
+
+ 
 The most used vertical grid for ORCA2 has $10~m$ ($500~m)$ resolution in the 
 surface (bottom) layers and a depth which varies from 0 at the sea surface to a 
@@ -721,5 +738,5 @@
 usually 10\%, of the default thickness $e_{3t}(jk)$).
 
- \colorbox{yellow}{Add a figure here of pstep especially at last ocean level }
+\gmcomment{ \colorbox{yellow}{Add a figure here of pstep especially at last ocean level }  }
 
 % -------------------------------------------------------------------------------------------------------------
@@ -860,23 +877,35 @@
 gives the number of ocean levels ($i.e.$ those that are not masked) at each 
 $t$-point. mbathy is computed from the meter bathymetry using the definiton of 
-gdept as the number of $t$-points which gdept $\leq$ bathy. 
+gdept as the number of $t$-points which gdept $\leq$ bathy.
 
 Modifications of the model bathymetry are performed in the \textit{bat\_ctl} 
 routine (see \mdl{domzgr} module) after mbathy is computed. Isolated grid points 
-that do not communicate with another ocean point at the same level are eliminated.
+that do not communicate with another ocean point at the same level are eliminated.\\
+
+As for the representation of bathymetry, a 2D integer array, misfdep, is created. 
+misfdep defines the level of the first wet $t$-point. All the cells between $k=1$ and $misfdep(i,j)-1$ are masked. 
+By default, misfdep(:,:)=1 and no cells are masked.
+
+In case of ice shelf cavities (\np{ln\_isfcav}~=~true), modifications of the model bathymetry and ice shelf draft in 
+the cavities are performed through the \textit{zgr\_isf} routine. The compatibility between ice shelf draft and bathymetry is checked: 
+if only one cell on the water column is opened at $t$-, $u$- or $v$-points, the bathymetry or the ice shelf draft is dug to have a 2-level water column 
+(i.e. two unmasked levels). If the incompatibility is too strong (i.e. need to dig more than one cell), the entire water column is masked.\\ 
 
 From the \textit{mbathy} array, the mask fields are defined as follows:
 \begin{align*}
-tmask(i,j,k) &= \begin{cases}   \; 1&   \text{ if $k\leq mbathy(i,j)$  }    \\
-                                                \; 0&   \text{ if $k\leq mbathy(i,j)$  }    \end{cases}     \\
+tmask(i,j,k) &= \begin{cases}   \; 0&   \text{ if $k < misfdep(i,j) $ } \\
+                                \; 1&   \text{ if $misfdep(i,j) \leq k\leq mbathy(i,j)$  }    \\
+                                \; 0&   \text{ if $k > mbathy(i,j)$  }    \end{cases}     \\
 umask(i,j,k) &=         \; tmask(i,j,k) \ * \ tmask(i+1,j,k)	\\
 vmask(i,j,k) &=         \; tmask(i,j,k) \ * \ tmask(i,j+1,k)	\\
 fmask(i,j,k) &=         \; tmask(i,j,k) \ * \ tmask(i+1,j,k)	\\
-                   & \ \ \, * tmask(i,j,k) \ * \ tmask(i+1,j,k)
+                   & \ \ \, * tmask(i,j,k) \ * \ tmask(i+1,j,k) \\
+wmask(i,j,k) &=         \; tmask(i,j,k) \ * \ tmask(i,j,k-1) \text{ with } wmask(i,j,1) = tmask(i,j,1) 
 \end{align*}
 
-Note that \textit{wmask} is not defined as it is exactly equal to \textit{tmask} with 
-the numerical indexing used (\S~\ref{DOM_Num_Index}). Moreover, the 
-specification of closed lateral boundaries requires that at least the first and last 
+Note, wmask is now defined. It allows, in case of ice shelves, 
+to deal with the top boundary (ice shelf/ocean interface) exactly in the same way as for the bottom boundary. 
+
+The specification of closed lateral boundaries requires that at least the first and last 
 rows and columns of the \textit{mbathy} array are set to zero. In the particular 
 case of an east-west cyclical boundary condition, \textit{mbathy} has its last 
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_DYN.tex
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_DYN.tex	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_DYN.tex	(revision 6440)
@@ -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}
@@ -165,11 +163,10 @@
 %-------------------------------------------------------------------------------------------------------------
 
-The vector invariant form of the momentum equations is the one most 
-often used in applications of the \NEMO ocean model. The flux form option 
-(see next section) has been present since version $2$. Options are defined
-through the \ngn{namdyn\_adv} namelist variables
-Coriolis and momentum advection terms are evaluated using a leapfrog 
-scheme, $i.e.$ the velocity appearing in these expressions is centred in 
-time (\textit{now} velocity). 
+The vector invariant form of the momentum equations (\np{ln\_dynhpg\_vec}~=~true) is the one most 
+often used in applications of the \NEMO ocean model. The flux form option (\np{ln\_dynhpg\_vec}~=false)
+(see next section) has been present since version $2$. 
+Options are defined through the \ngn{namdyn\_adv} namelist variables.
+Coriolis and momentum advection terms are evaluated using a leapfrog scheme, 
+$i.e.$ the velocity appearing in these expressions is centred in time (\textit{now} velocity). 
 At the lateral boundaries either free slip, no slip or partial slip boundary 
 conditions are applied following Chap.\ref{LBC}.
@@ -303,10 +300,13 @@
 %>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 
-Note that a key point in \eqref{Eq_een_e3f} is that the averaging in the \textbf{i}- and 
-\textbf{j}- directions uses the masked vertical scale factor but is always divided by 
-$4$, not by the sum of the masks at the four $T$-points. This preserves the continuity of 
-$e_{3f}$ when one or more of the neighbouring $e_{3t}$ tends to zero and 
-extends by continuity the value of $e_{3f}$ into the land areas. This feature is essential for 
-the $z$-coordinate with partial steps.
+A key point in \eqref{Eq_een_e3f} is how the averaging in the \textbf{i}- and \textbf{j}- directions is made. 
+It uses the sum of masked t-point vertical scale factor divided either 
+by the sum of the four t-point masks (\np{ln\_dynvor\_een\_old}~=~false), 
+or  just by $4$ (\np{ln\_dynvor\_een\_old}~=~true).
+The latter case preserves the continuity of $e_{3f}$ when one or more of the neighbouring $e_{3t}$ 
+tends to zero and extends by continuity the value of $e_{3f}$ into the land areas. 
+This case introduces a sub-grid-scale topography at f-points (with a systematic reduction of $e_{3f}$ 
+when a model level intercept the bathymetry) that tends to reinforce the topostrophy of the flow 
+($i.e.$ the tendency of the flow to follow the isobaths) \citep{Penduff_al_OS07}. 
 
 Next, the vorticity triads, $ {^i_j}\mathbb{Q}^{i_p}_{j_p}$ can be defined at a $T$-point as 
@@ -374,4 +374,11 @@
 \end{aligned}         \right.
 \end{equation} 
+When \np{ln\_dynzad\_zts}~=~\textit{true}, a split-explicit time stepping with 5 sub-timesteps is used 
+on the vertical advection term.
+This option can be useful when the value 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 tracer to ensure a better stability, 
+an option which is only available with a TVD scheme (see \np{ln\_traadv\_tvd\_zts} in \S\ref{TRA_adv_tvd}).
+
 
 % ================================================================
@@ -491,5 +498,6 @@
 those in the centred second order method. As the scheme already includes 
 a diffusion component, it can be used without explicit  lateral diffusion on momentum 
-($i.e.$ \np{ln\_dynldf\_lap}=\np{ln\_dynldf\_bilap}=false), and it is recommended to do so.
+($i.e.$ setting both \np{ln\_dynldf\_lap} and \np{ln\_dynldf\_bilap} to \textit{false}), 
+and it is recommended to do so.
 
 The UBS scheme is not used in all directions. In the vertical, the centred $2^{nd}$ 
@@ -629,7 +637,4 @@
 ($e_{3w}$).
  
-$\bullet$ Traditional coding with adaptation for ice shelf cavities (\np{ln\_dynhpg\_isf}=true).
-This scheme need the activation of ice shelf cavities (\np{ln\_isfcav}=true).
-
 $\bullet$ Pressure Jacobian scheme (prj) (a research paper in preparation) (\np{ln\_dynhpg\_prj}=true)
 
@@ -646,4 +651,20 @@
 pressure Jacobian method is used to solve the horizontal pressure gradient. This method can provide
 a more accurate calculation of the horizontal pressure gradient than the standard scheme.
+
+\subsection{Ice shelf cavity}
+\label{DYN_hpg_isf}
+Beneath an ice shelf, the total pressure gradient is the sum of the pressure gradient due to the ice shelf load and
+ the pressure gradient due to the ocean load. If cavities are present (\np{ln\_isfcav}~=~true) these two terms can be
+ calculated by setting \np{ln\_dynhpg\_isf}~=~true. No other scheme is working with ice shelves.\\
+
+$\bullet$ The main hypothesis to compute the ice shelf load is that the ice shelf is in isostatic equilibrium.
+ The top pressure is computed integrating a reference density profile (prescribed as density of a water at 34.4 
+PSU and -1.9$\degres C$) from the sea surface to the ice shelf base, which corresponds to the load of the water
+column in which the ice shelf is floatting. This top pressure is constant over time. A detailed description of 
+this method is described in \citet{Losch2008}.\\
+
+$\bullet$ The ocean load is computed using the expression \eqref{Eq_dynhpg_sco} described in \ref{DYN_hpg_sco}. 
+A treatment of the top and bottom partial cells similar to the one described in \ref{DYN_hpg_zps} is done 
+to reduce the residual circulation generated by the top partial cell. 
 
 %--------------------------------------------------------------------------------------------------------------
@@ -718,9 +739,17 @@
 $\ $\newline      %force an empty line
 
-%%%
 Options are defined through the \ngn{namdyn\_spg} namelist variables.
-The surface pressure gradient term is related to the representation of the free surface (\S\ref{PE_hor_pg}). The main distinction is between the fixed volume case (linear free surface) and the variable volume case (nonlinear free surface, \key{vvl} is defined). In the linear free surface case (\S\ref{PE_free_surface}) the vertical scale factors $e_{3}$ are fixed in time, while they are time-dependent in the nonlinear case (\S\ref{PE_free_surface}). With both linear and nonlinear free surface, external gravity waves are allowed in the equations, which imposes a very small time step when an explicit time stepping is used. Two methods are proposed to allow a longer time step for the three-dimensional equations: the filtered free surface, which is a modification of the continuous equations (see \eqref{Eq_PE_flt}), and the split-explicit free surface described below. The extra term introduced in the filtered method is calculated implicitly, so that the update of the next velocities is done in module \mdl{dynspg\_flt} and not in \mdl{dynnxt}.
-
-%%%
+The surface pressure gradient term is related to the representation of the free surface (\S\ref{PE_hor_pg}). 
+The main distinction is between the fixed volume case (linear free surface) and the variable volume case 
+(nonlinear free surface, \key{vvl} is defined). In the linear free surface case (\S\ref{PE_free_surface}) 
+the vertical scale factors $e_{3}$ are fixed in time, while they are time-dependent in the nonlinear case 
+(\S\ref{PE_free_surface}). 
+With both linear and nonlinear free surface, external gravity waves are allowed in the equations, 
+which imposes a very small time step when an explicit time stepping is used. 
+Two methods are proposed to allow a longer time step for the three-dimensional equations: 
+the filtered free surface, which is a modification of the continuous equations (see \eqref{Eq_PE_flt}), 
+and the split-explicit free surface described below. 
+The extra term introduced in the filtered method is calculated implicitly, 
+so that the update of the next velocities is done in module \mdl{dynspg\_flt} and not in \mdl{dynnxt}.
 
 
@@ -736,5 +765,4 @@
 implicitly, so that a solver is used to compute it. As a consequence the update of the $next$ 
 velocities is done in module \mdl{dynspg\_flt} and not in \mdl{dynnxt}.
-
 
 
@@ -779,5 +807,6 @@
 $\rdt_e = \rdt / nn\_baro$. This parameter can be optionally defined automatically (\np{ln\_bt\_nn\_auto}=true) 
 considering that the stability of the barotropic system is essentially controled by external waves propagation. 
-Maximum allowed Courant number is in that case time independent, and easily computed online from the input bathymetry.
+Maximum Courant number is in that case time independent, and easily computed online from the input bathymetry.
+Therefore, $\rdt_e$ is adjusted so that the Maximum allowed Courant number is smaller than \np{rn\_bt\_cmax}.
 
 %%%
@@ -802,5 +831,5 @@
 Schematic of the split-explicit time stepping scheme for the external 
 and internal modes. Time increases to the right. In this particular exemple, 
-a boxcar averaging window over $nn\_baro$ barotropic time steps is used ($nn\_bt\_filt=1$) and $nn\_baro=5$.
+a boxcar averaging window over $nn\_baro$ barotropic time steps is used ($nn\_bt\_flt=1$) and $nn\_baro=5$.
 Internal mode time steps (which are also the model time steps) are denoted 
 by $t-\rdt$, $t$ and $t+\rdt$. Variables with $k$ superscript refer to instantaneous barotropic variables, 
@@ -808,7 +837,7 @@
 The former are used to obtain time filtered quantities at $t+\rdt$ while the latter are used to obtain time averaged 
 transports to advect tracers.
-a) Forward time integration: \np{ln\_bt\_fw}=true, \np{ln\_bt\_ave}=true. 
-b) Centred time integration: \np{ln\_bt\_fw}=false, \np{ln\_bt\_ave}=true. 
-c) Forward time integration with no time filtering (POM-like scheme): \np{ln\_bt\_fw}=true, \np{ln\_bt\_ave}=false. }
+a) Forward time integration: \np{ln\_bt\_fw}=true, \np{ln\_bt\_av}=true. 
+b) Centred time integration: \np{ln\_bt\_fw}=false, \np{ln\_bt\_av}=true. 
+c) Forward time integration with no time filtering (POM-like scheme): \np{ln\_bt\_fw}=true, \np{ln\_bt\_av}=false. }
 \end{center}    \end{figure}
 %>   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >
@@ -816,5 +845,5 @@
 In the default case (\np{ln\_bt\_fw}=true), the external mode is integrated 
 between \textit{now} and  \textit{after} baroclinic time-steps (Fig.~\ref{Fig_DYN_dynspg_ts}a). To avoid aliasing of fast barotropic motions into three dimensional equations, time filtering is eventually applied on barotropic 
-quantities (\np{ln\_bt\_ave}=true). In that case, the integration is extended slightly beyond  \textit{after} time step to provide time filtered quantities. 
+quantities (\np{ln\_bt\_av}=true). In that case, the integration is extended slightly beyond  \textit{after} time step to provide time filtered quantities. 
 These are used for the subsequent initialization of the barotropic mode in the following baroclinic step. 
 Since external mode equations written at baroclinic time steps finally follow a forward time stepping scheme, 
@@ -837,5 +866,5 @@
 %%%
 
-One can eventually choose to feedback instantaneous values by not using any time filter (\np{ln\_bt\_ave}=false). 
+One can eventually choose to feedback instantaneous values by not using any time filter (\np{ln\_bt\_av}=false). 
 In that case, external mode equations are continuous in time, ie they are not re-initialized when starting a new 
 sub-stepping sequence. This is the method used so far in the POM model, the stability being maintained by refreshing at (almost) 
@@ -1158,12 +1187,19 @@
 
 Besides the surface and bottom stresses (see the above section) which are 
-introduced as boundary conditions on the vertical mixing, two other forcings 
-enter the dynamical equations. 
-
-One is the effect of atmospheric pressure on the ocean dynamics.
-Another forcing term is the tidal potential.
-Both of which will be introduced into the reference version soon. 
-
-\gmcomment{atmospheric pressure is there!!!!    include its description }
+introduced as boundary conditions on the vertical mixing, three other forcings 
+may enter the dynamical equations by affecting the surface pressure gradient. 
+
+(1) When \np{ln\_apr\_dyn}~=~true (see \S\ref{SBC_apr}), the atmospheric pressure is taken 
+into account when computing the surface pressure gradient.
+
+(2) When \np{ln\_tide\_pot}~=~true and \key{tide} is defined (see \S\ref{SBC_tide}), 
+the tidal potential is taken into account when computing the surface pressure gradient.
+
+(3) When \np{nn\_ice\_embd}~=~2 and LIM or CICE is used ($i.e.$ when the sea-ice is embedded in the ocean), 
+the snow-ice mass is taken into account when computing the surface pressure gradient.
+
+
+\gmcomment{ missing : the lateral boundary condition !!!   another external forcing
+ }
 
 % ================================================================
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_LBC.tex
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_LBC.tex	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_LBC.tex	(revision 6440)
@@ -1,4 +1,4 @@
 % ================================================================
-% Chapter � Lateral Boundary Condition (LBC) 
+% Chapter — Lateral Boundary Condition (LBC) 
 % ================================================================
 \chapter{Lateral Boundary Condition (LBC) }
@@ -204,10 +204,11 @@
 %        North fold (\textit{jperio = 3 }to $6)$ 
 % -------------------------------------------------------------------------------------------------------------
-\subsection{North-fold (\textit{jperio = 3 }to $6)$ }
+\subsection{North-fold (\textit{jperio = 3 }to $6$) }
 \label{LBC_north_fold}
 
 The north fold boundary condition has been introduced in order to handle the north 
-boundary of a three-polar ORCA grid. Such a grid has two poles in the northern hemisphere. 
-\colorbox{yellow}{to be completed...}
+boundary of a three-polar ORCA grid. Such a grid has two poles in the northern hemisphere 
+(Fig.\ref{Fig_MISC_ORCA_msh}, and thus requires a specific treatment illustrated in Fig.\ref{Fig_North_Fold_T}. 
+Further information can be found in \mdl{lbcnfd} module which applies the north fold boundary condition.
 
 %>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -250,10 +251,9 @@
 ocean model. Second order finite difference schemes lead to local discrete 
 operators that depend at the very most on one neighbouring point. The only 
-non-local computations concern the vertical physics (implicit diffusion, 1.5 
+non-local computations concern the vertical physics (implicit diffusion, 
 turbulent closure scheme, ...) (delocalization over the whole water column), 
 and the solving of the elliptic equation associated with the surface pressure 
 gradient computation (delocalization over the whole horizontal domain). 
 Therefore, a pencil strategy is used for the data sub-structuration 
-\gmcomment{no idea what this means!}
 : the 3D initial domain is laid out on local processor 
 memories following a 2D horizontal topological splitting. Each sub-domain 
@@ -264,16 +264,14 @@
 phase starts: each processor sends to its neighbouring processors the update 
 values of the points corresponding to the interior overlapping area to its 
-neighbouring sub-domain (i.e. the innermost of the two overlapping rows). 
-The communication is done through message passing. Usually the parallel virtual 
-language, PVM, is used as it is a standard language available on  nearly  all 
-MPP computers. More specific languages (i.e. computer dependant languages) 
-can be easily used to speed up the communication, such as SHEM on a T3E 
-computer. The data exchanges between processors are required at the very 
+neighbouring sub-domain ($i.e.$ the innermost of the two overlapping rows). 
+The communication is done through the Message Passing Interface (MPI). 
+The data exchanges between processors are required at the very 
 place where lateral domain boundary conditions are set in the mono-domain 
-computation (\S III.10-c): the lbc\_lnk routine which manages such conditions 
-is substituted by mpplnk.F or mpplnk2.F routine when running on an MPP 
-computer (\key{mpp\_mpi} defined). It has to be pointed out that when using 
-the MPP version of the model, the east-west cyclic boundary condition is done 
-implicitly, whilst the south-symmetric boundary condition option is not available.
+computation : the \rou{lbc\_lnk} routine (found in \mdl{lbclnk} module) 
+which manages such conditions is interfaced with routines found in \mdl{lib\_mpp} module 
+when running on an MPP computer ($i.e.$ when \key{mpp\_mpi} defined). 
+It has to be pointed out that when using the MPP version of the model, 
+the east-west cyclic boundary condition is done implicitly, 
+whilst the south-symmetric boundary condition option is not available.
 
 %>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -285,12 +283,10 @@
 %>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 
-In the standard version of the OPA model, the splitting is regular and arithmetic.
- the i-axis is divided by \jp{jpni} and the j-axis by \jp{jpnj} for a number of processors 
- \jp{jpnij} most often equal to $jpni \times jpnj$ (model parameters set in 
- \mdl{par\_oce}). Each processor is independent and without message passing 
- or synchronous process 
- \gmcomment{how does a synchronous process relate to this?}, 
- programs run alone and access just its own local memory. For this reason, the 
- main model dimensions are now the local dimensions of the subdomain (pencil) 
+In the standard version of \NEMO, the splitting is regular and arithmetic.
+The i-axis is divided by \jp{jpni} and the j-axis by \jp{jpnj} for a number of processors 
+\jp{jpnij} most often equal to $jpni \times jpnj$ (parameters set in 
+ \ngn{nammpp} namelist). Each processor is independent and without message passing 
+ or synchronous process, programs run alone and access just its own local memory. 
+ For this reason, the main model dimensions are now the local dimensions of the subdomain (pencil) 
  that are named \jp{jpi}, \jp{jpj}, \jp{jpk}. These dimensions include the internal 
  domain and the overlapping rows. The number of rows to exchange (known as 
@@ -304,12 +300,8 @@
 where \jp{jpni}, \jp{jpnj} are the number of processors following the i- and j-axis.
 
-\colorbox{yellow}{Figure IV.3: example of a domain splitting with 9 processors and 
-no east-west cyclic boundary conditions.}
-
-One also defines variables nldi and nlei which correspond to the internal 
-domain bounds, and the variables nimpp and njmpp which are the position 
-of the (1,1) grid-point in the global domain. An element of $T_{l}$, a local array 
-(subdomain) corresponds to an element of $T_{g}$, a global array 
-(whole domain) by the relationship: 
+One also defines variables nldi and nlei which correspond to the internal domain bounds, 
+and the variables nimpp and njmpp which are the position of the (1,1) grid-point in the global domain. 
+An element of $T_{l}$, a local array (subdomain) corresponds to an element of $T_{g}$, 
+a global array (whole domain) by the relationship: 
 \begin{equation} \label{Eq_lbc_nimpp}
 T_{g} (i+nimpp-1,j+njmpp-1,k) = T_{l} (i,j,k),
@@ -320,6 +312,5 @@
 nproc. In the standard version, a processor has no more than four neighbouring 
 processors named nono (for north), noea (east), noso (south) and nowe (west) 
-and two variables, nbondi and nbondj, indicate the relative position of the processor 
-\colorbox{yellow}{(see Fig.IV.3)}:
+and two variables, nbondi and nbondj, indicate the relative position of the processor :
 \begin{itemize}
 \item 		nbondi = -1 	an east neighbour, no west processor,
@@ -332,6 +323,4 @@
 processor on its overlapping row, and sends the data issued from internal 
 domain corresponding to the overlapping row of the other processor.
-		 
-\colorbox{yellow}{Figure IV.4: pencil splitting with the additional outer halos }
 
 
@@ -343,27 +332,20 @@
 global ocean where more than 50 \% of points are land points. For this reason, a 
 pre-processing tool can be used to choose the mpp domain decomposition with a 
-maximum number of only land points processors, which can then be eliminated. 
-(For example, the mpp\_optimiz tools, available from the DRAKKAR web site.) 
+maximum number of only land points processors, which can then be eliminated (Fig. \ref{Fig_mppini2})
+(For example, the mpp\_optimiz tools, available from the DRAKKAR web site). 
 This optimisation is dependent on the specific bathymetry employed. The user 
 then chooses optimal parameters \jp{jpni}, \jp{jpnj} and \jp{jpnij} with 
 $jpnij < jpni \times jpnj$, leading to the elimination of $jpni \times jpnj - jpnij$ 
-land processors. When those parameters are specified in module \mdl{par\_oce}, 
+land processors. When those parameters are specified in \ngn{nammpp} namelist, 
 the algorithm in the \rou{inimpp2} routine sets each processor's parameters (nbound, 
 nono, noea,...) so that the land-only processors are not taken into account. 
 
-\colorbox{yellow}{Note that the inimpp2 routine is general so that the original inimpp 
+\gmcomment{Note that the inimpp2 routine is general so that the original inimpp 
 routine should be suppressed from the code.}
 
 When land processors are eliminated, the value corresponding to these locations in 
-the model output files is zero. Note that this is a problem for a mesh output file written 
-by such a model configuration, because model users often divide by the scale factors 
-($e1t$, $e2t$, etc) and do not expect the grid size to be zero, even on land. It may be 
-best not to eliminate land processors when running the model especially to write the 
-mesh files as outputs (when \np{nn\_msh} namelist parameter differs from 0).
-%%
-\gmcomment{Steven : dont understand this, no land processor means no output file 
-covering this part of globe; its only when files are stitched together into one that you 
-can leave a hole}
-%%
+the model output files is undefined. Note that this is a problem for the meshmask file 
+which requires to be defined over the whole domain. Therefore, user should not eliminate 
+land processors when creating a meshmask file ($i.e.$ when setting a non-zero value to \np{nn\_msh}).
 
 %>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -380,360 +362,4 @@
 %>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 
-
-% ================================================================
-% Open Boundary Conditions 
-% ================================================================
-\section{Open Boundary Conditions (\key{obc}) (OBC)}
-\label{LBC_obc}
-%-----------------------------------------nam_obc  -------------------------------------------
-%-    nobc_dta    =    0     !  = 0 the obc data are equal to the initial state
-%-                           !  = 1 the obc data are read in 'obc   .dta' files
-%-    rn_dpein      =    1.    !  ???
-%-    rn_dpwin      =    1.    !  ???
-%-    rn_dpnin      =   30.    !  ???
-%-    rn_dpsin      =    1.    !  ???
-%-    rn_dpeob      = 1500.    !  time relaxation (days) for the east  open boundary
-%-    rn_dpwob      =   15.    !    "        "           for the west  open boundary
-%-    rn_dpnob      =  150.    !    "        "           for the north open boundary
-%-    rn_dpsob      =   15.    !    "        "           for the south open boundary
-%-    ln_obc_clim = .true.   !  climatological obc data files (default T)
-%-    ln_vol_cst  = .true.   !  total volume conserved
-\namdisplay{namobc} 
-
-It is often necessary to implement a model configuration limited to an oceanic 
-region or a basin, which communicates with the rest of the global ocean through 
-''open boundaries''. As stated by \citet{Roed1986}, an open boundary is a 
-computational border where the aim of the calculations is to allow the perturbations 
-generated inside the computational domain to leave it without deterioration of the 
-inner model solution. However, an open boundary also has to let information from 
-the outer ocean enter the model and should support inflow and outflow conditions. 
-
-The open boundary package OBC is the first open boundary option developed in 
-NEMO (originally in OPA8.2). It allows the user to 
-\begin{itemize}
-\item tell the model that a boundary is ''open'' and not closed by a wall, for example 
-by modifying the calculation of the divergence of velocity there;
-\item impose values of tracers and velocities at that boundary (values which may 
-be taken from a climatology): this is the``fixed OBC'' option. 
-\item calculate boundary values by a sophisticated algorithm combining radiation 
-and relaxation (``radiative OBC'' option)
-\end{itemize}
-
-Options are defined through the \ngn{namobc} namelist variables.
-The package resides in the OBC directory. It is described here in four parts: the 
-boundary geometry (parameters to be set in \mdl{obc\_par}), the forcing data at 
-the boundaries (module \mdl{obcdta}),  the radiation algorithm involving the 
-namelist and module \mdl{obcrad}, and a brief presentation of boundary update 
-and restart files.
-
-%----------------------------------------------
-\subsection{Boundary geometry}
-\label{OBC_geom}
-%
-First one has to realize that open boundaries may not necessarily be located 
-at the extremities of the computational domain. They may exist in the middle 
-of the domain, for example at Gibraltar Straits if one wants to avoid including 
-the Mediterranean in an Atlantic domain. This flexibility has been found necessary 
-for the CLIPPER project \citep{Treguier_al_JGR01}. Because of the complexity of the 
-geometry of ocean basins, it may even be necessary to have more than one 
-''west'' open boundary, more than one ''north'', etc. This is not possible with 
-the OBC option: only one open boundary of each kind, west, east, south and 
-north is allowed; these names refer to the grid geometry (not to the direction 
-of the geographical ''west'', ''east'', etc).
-
-The open boundary geometry is set by a series of parameters in the module 
-\mdl{obc\_par}. For an eastern open boundary, parameters are \jp{lp\_obc\_east} 
-(true if an east open boundary exists), \jp{jpieob} the $i$-index along which 
-the eastern open boundary (eob) is located, \jp{jpjed} the $j$-index at which 
-it starts, and \jp{jpjef} the $j$-index where it ends (note $d$ is for ''d\'{e}but'' 
-and $f$ for ''fin'' in French). Similar parameters exist for the west, south and 
-north cases (Table~\ref{Tab_obc_param}).
-
-
-%--------------------------------------------------TABLE--------------------------------------------------
-\begin{table}[htbp]     \begin{center}    \begin{tabular}{|l|c|c|c|}
-\hline
-Boundary and  & Constant index  & Starting index (d\'{e}but) & Ending index (fin) \\
-Logical flag  &                 &                            &                     \\
-\hline
-West          & \jp{jpiwob} $>= 2$         &  \jp{jpjwd}$>= 2$          &  \jp{jpjwf}<= \np{jpjglo}-1 \\
-lp\_obc\_west & $i$-index of a $u$ point   & $j$ of a $T$ point   &$j$ of a $T$ point \\
-\hline
-East            & \jp{jpieob}$<=$\np{jpiglo}-2&\jp{jpjed} $>= 2$         & \jp{jpjef}$<=$ \np{jpjglo}-1 \\
- lp\_obc\_east  & $i$-index of a $u$ point    & $j$ of a $T$ point & $j$ of a $T$ point \\
-\hline
-South           & \jp{jpjsob} $>= 2$         & \jp{jpisd} $>= 2$          & \jp{jpisf}$<=$\np{jpiglo}-1 \\
-lp\_obc\_south  & $j$-index of a $v$ point   & $i$ of a $T$ point   & $i$ of a $T$ point \\
-\hline
-North           & \jp{jpjnob} $<=$ \np{jpjglo}-2& \jp{jpind} $>= 2$        & \jp{jpinf}$<=$\np{jpiglo}-1 \\
-lp\_obc\_north  & $j$-index of a $v$ point      & $i$  of a $T$ point & $i$ of a $T$ point \\
-\hline
-\end{tabular}    \end{center}
-\caption{     \label{Tab_obc_param}
-Names of different indices relating to the open boundaries. In the case 
-of a completely open ocean domain with four ocean boundaries, the parameters 
-take exactly the values indicated.}
-\end{table}
-%------------------------------------------------------------------------------------------------------------
-
-The open boundaries must be along coordinate lines. On the C-grid, the boundary 
-itself is along a line of normal velocity points: $v$ points for a zonal open boundary 
-(the south or north one), and $u$ points for a meridional open boundary (the west 
-or east one). Another constraint is that there still must be a row of masked points 
-all around the domain, as if the domain were a closed basin (unless periodic conditions 
-are used together with open boundary conditions). Therefore, an open boundary 
-cannot be located at the first/last index, namely, 1, \jp{jpiglo} or \jp{jpjglo}. Also, 
-the open boundary algorithm involves calculating the normal velocity points situated 
-just on the boundary, as well as the tangential velocity and temperature and salinity 
-just outside the boundary. This means that for a west/south boundary, normal 
-velocities and temperature are calculated at the same index \jp{jpiwob} and 
-\jp{jpjsob}, respectively. For an east/north boundary, the normal velocity is 
-calculated at index \jp{jpieob} and \jp{jpjnob}, but the ``outside'' temperature is 
-at index \jp{jpieob}+1 and \jp{jpjnob}+1. This means that \jp{jpieob}, \jp{jpjnob} 
-cannot be bigger than \jp{jpiglo}-2, \jp{jpjglo}-2. 
-
-
-The starting and ending indices are to be thought of as $T$ point indices: in many 
-cases they indicate the first land $T$-point, at the extremity of an open boundary 
-(the coast line follows the $f$ grid points, see Fig.~\ref{Fig_obc_north} for an example 
-of a northern open boundary). All indices are relative to the global domain. In the 
-free surface case it is possible to have ``ocean corners'', that is, an open boundary 
-starting and ending in the ocean.
-
-%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-\begin{figure}[!t]     \begin{center}
-\includegraphics[width=0.70\textwidth]{./TexFiles/Figures/Fig_obc_north.pdf}
-\caption{    \label{Fig_obc_north}
-Localization of the North open boundary points.}
-\end{center}     \end{figure}
-%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-
-Although not compulsory, it is highly recommended that the bathymetry in the 
-vicinity of an open boundary follows the following rule: in the direction perpendicular 
-to the open line, the water depth should be constant for 4 grid points. This is in 
-order to ensure that the radiation condition, which involves model variables next 
-to the boundary, is calculated in a consistent way. On Fig.\ref{Fig_obc_north} we 
-indicate by an $=$ symbol, the points which should have the same depth. It means 
-that at the 4 points near the boundary, the bathymetry is cylindrical \gmcomment{not sure 
-why cylindrical}. The line behind the open $T$-line must be 0 in the bathymetry file 
-(as shown on Fig.\ref{Fig_obc_north} for example).
-
-%----------------------------------------------
-\subsection{Boundary data}
-\label{OBC_data}
-
-It is necessary to provide information at the boundaries. The simplest case is 
-when this information does not change in time and is equal to the initial conditions 
-(namelist variable \np{nn\_obcdta}=0). This is the case for the standard configuration 
-EEL5 with open boundaries. When (\np{nn\_obcdta}=1), open boundary information 
-is read from netcdf files. For convenience the input files are supposed to be similar 
-to the ''history'' NEMO output files, for dimension names and variable names. 
-Open boundary arrays must be dimensioned according to the parameters of table~
-\ref{Tab_obc_param}: for example, at the western boundary, arrays have a 
-dimension of \jp{jpwf}-\jp{jpwd}+1 in the horizontal and \jp{jpk} in the vertical. 
-
-When ocean observations are used to generate the boundary data (a hydrographic 
-section for example, as in \citet{Treguier_al_JGR01}) it happens often that only the velocity 
-normal to the boundary is known, which is the reason why the initial OBC code 
-assumes that only $T$, $S$, and the normal velocity ($u$ or $v$) needs to be 
-specified. As more and more global model solutions and ocean analysis products 
-become available, it will be possible to provide information about all the variables 
-(including the tangential velocity) so that the specification of four variables at each 
-boundaries will become standard. For the sea surface height, one must distinguish 
-between the filtered free surface case and the time-splitting or explicit treatment of 
-the free surface.
- In the first case, it is assumed that the user does not wish to represent high 
- frequency motions such as tides. The boundary condition is thus one of zero 
- normal gradient of sea surface height at the open boundaries, following \citet{Marchesiello2001}. 
-No information other than the total velocity needs to be provided at the open 
-boundaries in that case. In the other two cases (time splitting or explicit free surface), 
-the user must provide barotropic information (sea surface height and barotropic 
-velocities) and the use of the Flather algorithm for barotropic variables is 
-recommanded. However, this algorithm has not yet been fully tested and bugs 
-remain in NEMO v2.3. Users should read the code carefully before using it. Finally, 
-in the case of the rigid lid approximation the barotropic streamfunction must be 
-provided, as documented in \citet{Treguier_al_JGR01}). This option is no longer 
-recommended but remains in NEMO V2.3.
-
-One frequently encountered case is when an open boundary domain is constructed 
-from a global or larger scale NEMO configuration. Assuming the domain corresponds 
-to indices $ib:ie$, $jb:je$ of the global domain, the bathymetry and forcing of the 
-small domain can be created by using the following netcdf utility on the global files: 
-ncks -F $-d\;x,ib,ie$ $-d\;y,jb,je$ (part of the nco series of utilities, 
-see their \href{http://nco.sourceforge.net}{website}). 
-The open boundary files can be constructed using ncks 
-commands, following table~\ref{Tab_obc_ind}. 
-
-%--------------------------------------------------TABLE--------------------------------------------------
-\begin{table}[htbp]     \begin{center}      \begin{tabular}{|l|c|c|c|c|c|}
-\hline
-OBC  & Variable   & file name      & Index  & Start  & end  \\
-West &  T,S       &   obcwest\_TS.nc &  $ib$+1     &   $jb$+1 &  $je-1$  \\
-     &    U       &   obcwest\_U.nc  &  $ib$+1     &   $jb$+1 &  $je-1$  \\ 
-     &    V       &   obcwest\_V.nc  &  $ib$+1     &   $jb$+1 &  $je-1$  \\       
-\hline
-East &  T,S       &   obceast\_TS.nc &  $ie$-1     &   $jb$+1 &  $je-1$  \\
-     &    U       &   obceast\_U.nc  &  $ie$-2     &   $jb$+1 &  $je-1$  \\ 
-     &    V       &   obceast\_V.nc  &  $ie$-1     &   $jb$+1 &  $je-1$  \\       
-\hline         
-South &  T,S      &   obcsouth\_TS.nc &  $jb$+1     &  $ib$+1 &  $ie-1$  \\
-      &    U      &   obcsouth\_U.nc  &  $jb$+1     &  $ib$+1 &  $ie-1$  \\ 
-      &    V      &   obcsouth\_V.nc  &  $jb$+1     &  $ib$+1 &  $ie-1$  \\    
-\hline
-North &  T,S      &   obcnorth\_TS.nc &  $je$-1     &  $ib$+1 &  $ie-1$  \\
-      &    U      &   obcnorth\_U.nc  &  $je$-1     &  $ib$+1 &  $ie-1$  \\ 
-      &    V      &   obcnorth\_V.nc  &  $je$-2     &  $ib$+1 &  $ie-1$  \\  
-\hline
-\end{tabular}     \end{center}
-\caption{    \label{Tab_obc_ind}
-Requirements for creating open boundary files from a global configuration, 
-appropriate for the subdomain of indices $ib:ie$, $jb:je$. ``Index'' designates the 
-$i$ or $j$ index along which the $u$ of $v$ boundary point is situated in the global 
-configuration, starting and ending with the $j$ or $i$ indices indicated. 
-For example, to generate file obcnorth\_V.nc, use the command ncks 
-$-F$ $-d\;y,je-2$  $-d\;x,ib+1,ie-1$ } 
-\end{table}
-%-----------------------------------------------------------------------------------------------------------
-
-It is assumed that the open boundary files contain the variables for the period of 
-the model integration. If the boundary files contain one time frame, the boundary 
-data is held fixed in time. If the files contain 12 values, it is assumed that the input 
-is a climatology for a repeated annual cycle (corresponding to the case \np{ln\_obc\_clim} 
-=true). The case of an arbitrary number of time frames is not yet implemented 
-correctly; the user is required to write his own code in the module \mdl{obc\_dta} 
-to deal with this situation. 
-
-\subsection{Radiation algorithm}
-\label{OBC_rad}
-
-The art of open boundary management consists in applying a constraint strong 
-enough that the inner domain "feels" the rest of the ocean, but weak enough
-that perturbations are allowed to leave the domain with minimum false reflections 
-of energy. The constraints are specified separately at each boundary as time 
-scales for ''inflow'' and ''outflow'' as defined below. The time scales are set (in days) 
-by namelist parameters such as \np{rn\_dpein}, \np{rn\_dpeob} for the eastern open 
-boundary for example. When both time scales are zero for a given boundary 
-($e.g.$ for the western boundary, \jp{lp\_obc\_west}=true, \np{rn\_dpwob}=0 and 
-\np{rn\_dpwin}=0) this means that the boundary in question is a ''fixed '' boundary 
-where the solution is set exactly by the boundary data. This is not recommended, 
-except in combination with increased viscosity in a ''sponge'' layer next to the 
-boundary in order to avoid spurious reflections.  
-
-
-The radiation\/relaxation \gmcomment{the / doesnt seem to appear in the output} 
-algorithm is applied when either relaxation time (for ''inflow'' or ''outflow'') is 
-non-zero. It has been developed and tested in the SPEM model and its 
-successor ROMS \citep{Barnier1996, Marchesiello2001}, which is an 
-$s$-coordinate model on an Arakawa C-grid. Although the algorithm has 
-been numerically successful in the CLIPPER Atlantic models, the physics 
-do not work as expected \citep{Treguier_al_JGR01}. Users are invited to consider 
-open boundary conditions (OBC hereafter) with some scepticism 
-\citep{Durran2001, Blayo2005}.
-
-The first part of the algorithm calculates a phase velocity to determine 
-whether perturbations tend to propagate toward, or away from, the 
-boundary. Let us consider a model variable $\phi$. 
-The phase velocities ($C_{\phi x}$,$C_{\phi y}$) for the variable $\phi$, 
-in the directions normal and tangential to the boundary are
-\begin{equation} \label{Eq_obc_cphi}
-C_{\phi x} = \frac{ -\phi_{t} }{ ( \phi_{x}^{2} + \phi_{y}^{2}) } \phi_{x} 
-\;\;\;\;\; \;\;\; 
-C_{\phi y} = \frac{ -\phi_{t} }{ ( \phi_{x}^{2} + \phi_{y}^{2}) } \phi_{y}. 
-\end{equation}
-Following \citet{Treguier_al_JGR01} and \citet{Marchesiello2001} we retain only 
-the normal component of the velocity, $C_{\phi x}$, setting $C_{\phi y} =0$ 
-(but unlike the original Orlanski radiation algorithm we retain $\phi_{y}$ in 
-the expression for $C_{\phi x}$).  
-
-The discrete form of (\ref{Eq_obc_cphi}), described by \citet{Barnier1998},
-takes into account the two rows of grid points situated inside the domain 
-next to the boundary, and the three previous time steps ($n$, $n-1$,
-and $n-2$). The same equation can then be discretized at the boundary at
-time steps $n-1$, $n$ and $n+1$ \gmcomment{since the original was three time-level} 
-in order to extrapolate for the new boundary value $\phi^{n+1}$. 
-
-In the open boundary algorithm as implemented in NEMO v2.3, the new boundary 
-values are updated differently depending on the sign of $C_{\phi x}$. Let us take 
-an eastern boundary as an example. The solution for variable $\phi$ at the 
-boundary is given by a generalized wave equation with phase velocity $C_{\phi}$, 
-with the addition of a relaxation term, as:
-\begin{eqnarray}
-\phi_{t} &  =  & -C_{\phi x} \phi_{x} + \frac{1}{\tau_{o}} (\phi_{c}-\phi) 
-                        \;\;\; \;\;\; \;\;\; (C_{\phi x} > 0), \label{Eq_obc_rado} \\
-\phi_{t} &  =  & \frac{1}{\tau_{i}} (\phi_{c}-\phi) 
-\;\;\; \;\;\; \;\;\;\;\;\; (C_{\phi x} < 0), \label{Eq_obc_radi}
-\end{eqnarray}
-where $\phi_{c}$ is the estimate of $\phi$ at the boundary, provided as boundary 
-data. Note that in (\ref{Eq_obc_rado}), $C_{\phi x}$ is bounded by the ratio 
-$\delta x/\delta t$ for stability reasons. When $C_{\phi x}$ is eastward (outward 
-propagation), the radiation condition (\ref{Eq_obc_rado}) is used. 
-When  $C_{\phi x}$ is westward (inward propagation), (\ref{Eq_obc_radi}) is 
-used with a strong relaxation to climatology (usually $\tau_{i}=\np{rn\_dpein}=$1~day).
-Equation (\ref{Eq_obc_radi}) is solved with a Euler time-stepping scheme. As a 
-consequence, setting $\tau_{i}$ smaller than, or equal to the time step is equivalent 
-to a fixed boundary condition. A time scale of one day is usually a good compromise 
-which guarantees that the inflow conditions remain close to climatology while ensuring 
-numerical stability. 
-
-In  the case of a western boundary located in the Eastern Atlantic, \citet{Penduff_al_JGR00} 
-have been able to implement the radiation algorithm without any boundary data, 
-using persistence from the previous time step instead. This solution has not worked 
-in other cases \citep{Treguier_al_JGR01}, so that the use of boundary data is recommended. 
-Even in the outflow condition (\ref{Eq_obc_rado}), we have found it desirable to 
-maintain a weak relaxation to climatology. The time step is usually chosen so as to 
-be larger than typical turbulent scales (of order 1000~days \gmcomment{or maybe seconds?}).
-
-The radiation condition is applied to the model variables: temperature, salinity, 
-tangential and normal velocities. For normal and tangential velocities, $u$ and $v$, 
-radiation is applied with phase velocities calculated from $u$ and $v$ respectively.  
-For the radiation of tracers, we use the phase velocity calculated from the tangential 
-velocity in order to avoid calculating too many independent radiation velocities and 
-because tangential velocities and tracers have the same position along the boundary 
-on a C-grid.  
-
-\subsection{Domain decomposition (\key{mpp\_mpi})}
-\label{OBC_mpp}
-When \key{mpp\_mpi} is active in the code, the computational domain is divided 
-into rectangles that are attributed each to a different processor. The open boundary 
-code is ``mpp-compatible'' up to a certain point. The radiation algorithm will not 
-work if there is an mpp subdomain boundary parallel to the open boundary at the 
-index of the boundary, or the grid point after (outside), or three grid points before 
-(inside). On the other hand, there is no problem if an mpp subdomain boundary 
-cuts the open boundary perpendicularly. These geometrical limitations must be 
-checked for by the user (there is no safeguard in the code).  
-The general principle for the open boundary mpp code is that loops over the open 
-boundaries {not sure what this means} are performed on local indices (nie0, 
-nie1, nje0, nje1 for an eastern boundary for instance) that are initialized in module 
-\mdl{obc\_ini}. Those indices have relevant values on the processors that contain 
-a segment of an open boundary. For processors that do not include an open 
-boundary segment, the indices are such that the calculations within the loops are 
-not performed.
-\gmcomment{I dont understand most of the last few sentences}
- 
-Arrays of climatological data that are read from files are seen by all processors 
-and have the same dimensions for all (for instance, for the eastern boundary, 
-uedta(jpjglo,jpk,2)). On the other hand, the arrays for the calculation of radiation 
-are local to each processor (uebnd(jpj,jpk,3,3) for instance).  This allowed the 
-CLIPPER model for example, to save on memory where the eastern boundary 
-crossed 8 processors so that \jp{jpj} was much smaller than (\jp{jpjef}-\jp{jpjed}+1). 
-
-\subsection{Volume conservation}
-\label{OBC_vol}
-
-It is necessary to control the volume inside a domain when using open boundaries. 
-With fixed boundaries, it is enough to ensure that the total inflow/outflow has 
-reasonable values (either zero or a value compatible with an observed volume 
-balance). When using radiative boundary conditions it is necessary to have a 
-volume constraint because each open boundary works independently from the 
-others. The methodology used to control this volume is identical to the one 
-coded in the ROMS model \citep{Marchesiello2001}.
-
-
-%---------------------------------------- EXTRAS
-\colorbox{yellow}{Explain obc\_vol{\ldots}}
-
-\colorbox{yellow}{OBC algorithm for update, OBC restart, list of routines where obc key appears{\ldots}}
-
-\colorbox{yellow}{OBC rigid lid? {\ldots}}
 
 % ====================================================================
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_LDF.tex
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_LDF.tex	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_LDF.tex	(revision 6440)
@@ -1,5 +1,5 @@
 
 % ================================================================
-% Chapter � Lateral Ocean Physics (LDF)
+% Chapter ———  Lateral Ocean Physics (LDF)
 % ================================================================
 \chapter{Lateral Ocean Physics (LDF)}
@@ -68,5 +68,5 @@
 When none of the \textbf{key\_dynldf\_...} and \textbf{key\_traldf\_...} keys are 
 defined, a constant value is used over the whole ocean for momentum and 
-tracers, which is specified through the \np{rn\_ahm0} and \np{rn\_aht0} namelist 
+tracers, which is specified through the \np{rn\_ahm\_0\_lap} and \np{rn\_aht\_0} namelist 
 parameters.
 
@@ -77,5 +77,5 @@
 mixing coefficients will require 3D arrays. In the 1D option, a hyperbolic variation 
 of the lateral mixing coefficient is introduced in which the surface value is 
-\np{rn\_aht0} (\np{rn\_ahm0}), the bottom value is 1/4 of the surface value, 
+\np{rn\_aht\_0} (\np{rn\_ahm\_0\_lap}), the bottom value is 1/4 of the surface value, 
 and the transition takes place around z=300~m with a width of 300~m 
 ($i.e.$ both the depth and the width of the inflection point are set to 300~m). 
@@ -93,5 +93,5 @@
 \end{equation}
 where $e_{max}$ is the maximum of $e_1$ and $e_2$ taken over the whole masked 
-ocean domain, and $A_o^l$ is the \np{rn\_ahm0} (momentum) or \np{rn\_aht0} (tracer) 
+ocean domain, and $A_o^l$ is the \np{rn\_ahm\_0\_lap} (momentum) or \np{rn\_aht\_0} (tracer) 
 namelist parameter. This variation is intended to reflect the lesser need for subgrid 
 scale eddy mixing where the grid size is smaller in the domain. It was introduced in 
@@ -105,6 +105,6 @@
 Other formulations can be introduced by the user for a given configuration. 
 For example, in the ORCA2 global ocean model (see Configurations), the laplacian 
-viscosity operator uses \np{rn\_ahm0}~= 4.10$^4$ m$^2$/s poleward of 20$^{\circ}$ 
-north and south and decreases linearly to \np{rn\_aht0}~= 2.10$^3$ m$^2$/s 
+viscosity operator uses \np{rn\_ahm\_0\_lap}~= 4.10$^4$ m$^2$/s poleward of 20$^{\circ}$ 
+north and south and decreases linearly to \np{rn\_aht\_0}~= 2.10$^3$ m$^2$/s 
 at the equator \citep{Madec_al_JPO96, Delecluse_Madec_Bk00}. This modification 
 can be found in routine \rou{ldf\_dyn\_c2d\_orca} defined in \mdl{ldfdyn\_c2d}. 
@@ -120,11 +120,94 @@
 \subsubsection{Space and Time Varying Mixing Coefficients}
 
-There is no default specification of space and time varying mixing coefficient. 
-The only case available is specific to the ORCA2 and ORCA05 global ocean 
-configurations. It provides only a tracer 
-mixing coefficient for eddy induced velocity (ORCA2) or both iso-neutral and 
-eddy induced velocity (ORCA05) that depends on the local growth rate of 
-baroclinic instability. This specification is actually used when an ORCA key 
+There are no default specifications of space and time varying mixing coefficient.  One
+available case is specific to the ORCA2 and ORCA05 global ocean configurations. It
+provides only a tracer mixing coefficient for eddy induced velocity (ORCA2) or both
+iso-neutral and eddy induced velocity (ORCA05) that depends on the local growth rate of
+baroclinic instability. This specification is actually used when an ORCA key
 and both \key{traldf\_eiv} and \key{traldf\_c2d} are defined.
+
+\subsubsection{Smagorinsky viscosity (\key{dynldf\_c3d} and \key{dynldf\_smag})}
+
+The \key{dynldf\_smag} key activates a 3D, time-varying viscosity that depends on the
+resolved motions. Following \citep{Smagorinsky_93} the viscosity coefficient is set
+proportional to a local deformation rate based on the horizontal shear and tension,
+namely:
+
+\begin{equation}
+A_{m_{Smag}} = \left(\frac{{\sf CM_{Smag}}}{\pi}\right)^2L^2\vert{D}\vert
+\end{equation}
+
+\noindent where the deformation rate $\vert{D}\vert$ is given by 
+
+\begin{equation}
+\vert{D}\vert=\sqrt{\left({\frac{\partial{u}} {\partial{x}}}
+                         -{\frac{\partial{v}} {\partial{y}}}\right)^2
+                 +  \left({\frac{\partial{u}} {\partial{y}}}
+                         +{\frac{\partial{v}} {\partial{x}}}\right)^2} 
+\end{equation}
+
+\noindent and $L$ is the local gridscale given by:
+
+\begin{equation}
+L^2 = \frac{2{e_1}^2 {e_2}^2}{\left ( {e_1}^2 + {e_2}^2 \right )}
+\end{equation}
+
+\citep{Griffies_Hallberg_MWR00} suggest values in the range 2.2 to 4.0 of the coefficient
+$\sf CM_{Smag}$ for oceanic flows. This value is set via the \np{rn\_cmsmag\_1} namelist
+parameter. An additional parameter: \np{rn\_cmsh} is included in NEMO for experimenting
+with the contribution of the shear term. A value of 1.0 (the default) calculates the
+deformation rate as above; a value of 0.0 will discard the shear term entirely.
+
+For numerical stability, the calculated viscosity is bounded according to the following:
+
+\begin{equation}
+{\rm MIN}\left ({ L^2\over {8\Delta{t}}}, rn\_ahm\_m\_lap\right ) \geq A_{m_{Smag}} 
+                                                                  \geq rn\_ahm\_0\_lap
+\end{equation}
+
+\noindent with both parameters for the upper and lower bounds being provided via the
+indicated namelist parameters.
+
+\bigskip When $ln\_dynldf\_bilap = .true.$, a biharmonic version of the Smagorinsky
+viscosity is also available which sets a coefficient for the biharmonic viscosity as:
+
+\begin{equation}
+B_{m_{Smag}} = - \left(\frac{{\sf CM_{bSmag}}}{\pi}\right)^2 {L^4\over 8}\vert{D}\vert
+\end{equation}
+
+\noindent which is bounded according to:
+
+\begin{equation}
+{\rm MAX}\left (-{ L^4\over {64\Delta{t}}}, rn\_ahm\_m\_blp\right ) \leq B_{m_{Smag}} 
+                                                                    \leq rn\_ahm\_0\_blp
+\end{equation}
+
+\noindent Note the reversal of the inequalities here because NEMO requires the biharmonic
+coefficients as negative numbers. $\sf CM_{bSmag}$ is set via the \np{rn\_cmsmag\_2}
+namelist parameter and the bounding values have corresponding entries in the namelist too.
+
+\bigskip The current implementation in NEMO also allows for 3D, time-varying diffusivities
+to be set using the Smagorinsky approach. Users should note that this option is not
+recommended for many applications since diffusivities will tend to be largest near
+boundaries (where shears are greatest) leading to spurious upwellings
+(\citep{Griffies_Bk04}, chapter 18.3.4). Nevertheless the option is there for those
+wishing to experiment. This choice requires both \key{traldf\_c3d} and \key{traldf\_smag}
+and uses the \np{rn\_chsmag} (${\sf CH_{Smag}}$), \np{rn\_smsh} and \np{rn\_aht\_m}
+namelist parameters in an analogous way to \np{rn\_cmsmag\_1}, \np{rn\_cmsh} and
+\np{rn\_ahm\_m\_lap} (see above) to set the diffusion coefficient:
+
+\begin{equation}
+A_{h_{Smag}} = \left(\frac{{\sf CH_{Smag}}}{\pi}\right)^2L^2\vert{D}\vert
+\end{equation}
+
+ 
+For numerical stability, the calculated diffusivity is bounded according to the following:
+
+\begin{equation}
+{\rm MIN}\left ({ L^2\over {8\Delta{t}}}, rn\_aht\_m\right ) \geq A_{h_{Smag}} 
+                                                             \geq rn\_aht\_0
+\end{equation}
+
+
 
 $\ $\newline    % force a new ligne
@@ -144,5 +227,5 @@
 (3) for isopycnal diffusion on momentum or tracers, an additional purely 
 horizontal background diffusion with uniform coefficient can be added by 
-setting a non zero value of \np{rn\_ahmb0} or \np{rn\_ahtb0}, a background horizontal 
+setting a non zero value of \np{rn\_ahmb\_0} or \np{rn\_ahtb\_0}, a background horizontal 
 eddy viscosity or diffusivity coefficient (namelist parameters whose default 
 values are $0$). However, the technique used to compute the isopycnal 
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_MISC.tex
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_MISC.tex	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_MISC.tex	(revision 6440)
@@ -34,12 +34,6 @@
 has been made to set them in a generic way. However, examples of how 
 they can be set up is given in the ORCA 2\deg and 0.5\deg configurations. For example, 
-for details of implementation in ORCA2, search:
-\vspace{-10pt}  
-\begin{alltt}  
-\tiny    
-\begin{verbatim}
-IF( cp_cfg == "orca" .AND. jp_cfg == 2 )
-\end{verbatim}  
-\end{alltt}
+for details of implementation in ORCA2, search: 
+\texttt{ IF( cp\_cfg == "orca" .AND. jp\_cfg == 2 ) }
 
 % -------------------------------------------------------------------------------------------------------------
@@ -89,6 +83,6 @@
 %--------------------------------------------------------------------------------------------------------------
 
-\colorbox{yellow}{Add a short description of CLA staff here or in lateral boundary condition chapter?}
 Options are defined through the  \ngn{namcla} namelist variables.
+This option is an obsolescent feature that will be removed in version 3.7 and followings. 
 
 %The problem is resolved here by allowing the mixing of tracers and mass/volume between non-adjacent water columns at nominated regions within the model. Momentum is not mixed. The scheme conserves total tracer content, and total volume (the latter in $z*$- or $s*$-coordinate), and maintains compatibility between the tracer and mass/volume budgets.  
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_Model_Basics.tex
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_Model_Basics.tex	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_Model_Basics.tex	(revision 6440)
@@ -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 line
 
 % ================================================================
@@ -773,10 +713,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 +727,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 +735,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 +778,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}=
@@ -1023,6 +992,8 @@
 \label{PE_zco_tilde}
 
-The $\tilde{z}$-coordinate has been developed by \citet{Leclair_Madec_OM10s}.
-It is not available in the current version of \NEMO.
+The $\tilde{z}$-coordinate has been developed by \citet{Leclair_Madec_OM11}.
+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.
+
 
 \newpage 
@@ -1157,7 +1128,7 @@
 operator acting along $s-$surfaces (see \S\ref{LDF}).
 
-\subsubsection{Lateral second order tracer diffusive operator}
-
-The lateral second order tracer diffusive operator is defined by (see Appendix~\ref{Apdx_B}):
+\subsubsection{Lateral Laplacian tracer diffusive operator}
+
+The lateral Laplacian tracer diffusive operator is defined by (see Appendix~\ref{Apdx_B}):
 \begin{equation} \label{Eq_PE_iso_tensor}
 D^{lT}=\nabla {\rm {\bf .}}\left( {A^{lT}\;\Re \;\nabla T} \right) \qquad 
@@ -1180,8 +1151,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 
@@ -1231,19 +1204,17 @@
 to zero in the vicinity of the boundaries. The latter strategy is used in \NEMO (cf. Chap.~\ref{LDF}).
 
-\subsubsection{Lateral fourth order tracer diffusive operator}
-
-The lateral fourth order tracer diffusive operator is defined by:
+\subsubsection{Lateral bilaplacian tracer diffusive operator}
+
+The lateral bilaplacian 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)
  \end{equation}
-
 It is the second order operator given by \eqref{Eq_PE_iso_tensor} applied twice with 
 the eddy diffusion coefficient correctly placed. 
 
-
-\subsubsection{Lateral second order momentum diffusive operator}
-
-The second order momentum diffusive operator along $z$- or $s$-surfaces is found by 
+\subsubsection{Lateral Laplacian momentum diffusive operator}
+
+The Laplacian momentum diffusive operator along $z$- or $s$-surfaces is found by 
 applying \eqref{Eq_PE_lap_vector} to the horizontal velocity vector (see Appendix~\ref{Apdx_B}):
 \begin{equation} \label{Eq_PE_lapU}
@@ -1279,5 +1250,5 @@
 of the Equator in a geographical coordinate system \citep{Lengaigne_al_JGR03}.
 
-\subsubsection{lateral fourth order momentum diffusive operator}
+\subsubsection{lateral bilaplacian momentum diffusive operator}
 
 As for tracers, the fourth order momentum diffusive operator along $z$ or $s$-surfaces 
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_Model_Basics_zstar.tex
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_Model_Basics_zstar.tex	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_Model_Basics_zstar.tex	(revision 6440)
@@ -1,4 +1,4 @@
 % ================================================================
-% Chapter 1 � Model Basics
+% Chapter 1 ——— Model Basics
 % ================================================================
 % ================================================================
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_SBC.tex
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_SBC.tex	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_SBC.tex	(revision 6440)
@@ -1,4 +1,4 @@
 % ================================================================
-% Chapter � Surface Boundary Condition (SBC, ISF, ICB) 
+% Chapter —— Surface Boundary Condition (SBC, ISF, ICB) 
 % ================================================================
 \chapter{Surface Boundary Condition (SBC, ISF, ICB) }
@@ -17,5 +17,6 @@
 	\item the two components of the surface ocean stress $\left( {\tau _u \;,\;\tau _v} \right)$
 	\item the incoming solar and non solar heat fluxes $\left( {Q_{ns} \;,\;Q_{sr} } \right)$
-	\item the surface freshwater budget $\left( {\textit{emp},\;\textit{emp}_S } \right)$
+	\item the surface freshwater budget $\left( {\textit{emp}} \right)$
+	\item the surface salt flux associated with freezing/melting of seawater $\left( {\textit{sfx}} \right)$
 \end{itemize}
 plus an optional field:
@@ -27,14 +28,13 @@
 are controlled by namelist \ngn{namsbc} variables: an analytical formulation (\np{ln\_ana}~=~true), 
 a flux formulation (\np{ln\_flx}~=~true), a bulk formulae formulation (CORE 
-(\np{ln\_core}~=~true), CLIO (\np{ln\_clio}~=~true) or MFS
+(\np{ln\_blk\_core}~=~true), CLIO (\np{ln\_blk\_clio}~=~true) or MFS
 \footnote { Note that MFS bulk formulae compute fluxes only for the ocean component}
-(\np{ln\_mfs}~=~true) bulk formulae) and a coupled 
-formulation (exchanges with a atmospheric model via the OASIS coupler) 
-(\np{ln\_cpl}~=~true). When used, the atmospheric pressure forces both 
-ocean and ice dynamics (\np{ln\_apr\_dyn}~=~true).
-The frequency at which the six or seven fields have to be updated is the \np{nn\_fsbc} 
-namelist parameter. 
+(\np{ln\_blk\_mfs}~=~true) bulk formulae) and a coupled or mixed forced/coupled formulation 
+(exchanges with a atmospheric model via the OASIS coupler) (\np{ln\_cpl} or \np{ln\_mixcpl}~=~true). 
+When used ($i.e.$ \np{ln\_apr\_dyn}~=~true), the atmospheric pressure forces both ocean and ice dynamics.
+
+The frequency at which the forcing fields have to be updated is given by the \np{nn\_fsbc} namelist parameter. 
 When the fields are supplied from data files (flux and bulk formulations), the input fields 
-need not be supplied on the model grid.  Instead a file of coordinates and weights can 
+need not be supplied on the model grid. Instead a file of coordinates and weights can 
 be supplied which maps the data from the supplied grid to the model points 
 (so called "Interpolation on the Fly", see \S\ref{SBC_iof}).
@@ -42,17 +42,20 @@
 can be masked to avoid spurious results in proximity of the coasts  as large sea-land gradients characterize
 most of the atmospheric variables.
+
 In addition, the resulting fields can be further modified using several namelist options. 
-These options control  the rotation of vector components supplied relative to an east-north 
-coordinate system onto the local grid directions in the model; the addition of a surface 
-restoring term to observed SST and/or SSS (\np{ln\_ssr}~=~true); the modification of fluxes 
-below ice-covered areas (using observed ice-cover or a sea-ice model) 
-(\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); 
-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 
-cycle (\np{ln\_dm2dc}~=~true); and a neutral drag coefficient can be read from an external wave 
-model (\np{ln\_cdgw}~=~true). The latter option is possible only in case core or mfs bulk formulas are selected.
+These options control 
+\begin{itemize}
+\item the rotation of vector components supplied relative to an east-north 
+coordinate system onto the local grid directions in the model ; 
+\item the addition of a surface restoring term to observed SST and/or SSS (\np{ln\_ssr}~=~true) ; 
+\item the modification of fluxes below ice-covered areas (using observed ice-cover or a sea-ice model) (\np{nn\_ice}~=~0,1, 2 or 3) ; 
+\item the addition of river runoffs as surface freshwater fluxes or lateral inflow (\np{ln\_rnf}~=~true) ; 
+\item the addition of isf melting as lateral inflow (parameterisation) (\np{nn\_isf}~=~2 or 3 and \np{ln\_isfcav}~=~false) 
+or as fluxes applied at the land-ice ocean interface (\np{nn\_isf}~=~1 or 4 and \np{ln\_isfcav}~=~true) ; 
+\item the addition of a freshwater flux adjustment in order to avoid a mean sea-level drift (\np{nn\_fwb}~=~0,~1~or~2) ; 
+\item the transformation of the solar radiation (if provided as daily mean) into a diurnal cycle (\np{ln\_dm2dc}~=~true) ; 
+and a neutral drag coefficient can be read from an external wave model (\np{ln\_cdgw}~=~true). 
+\end{itemize}
+The latter option is possible only in case core or mfs bulk formulas are selected.
 
 In this chapter, we first discuss where the surface boundary condition appears in the
@@ -73,69 +76,31 @@
 
 The surface ocean stress is the stress exerted by the wind and the sea-ice 
-on the ocean. The two components of stress are assumed to be interpolated 
-onto the ocean mesh, $i.e.$ resolved onto the model (\textbf{i},\textbf{j}) direction 
-at $u$- and $v$-points They are applied as a surface boundary condition of the 
-computation of the momentum vertical mixing trend (\mdl{dynzdf} module) :
-\begin{equation} \label{Eq_sbc_dynzdf}
-\left.{\left( {\frac{A^{vm} }{e_3 }\ \frac{\partial \textbf{U}_h}{\partial k}} \right)} \right|_{z=1}
-	 = \frac{1}{\rho _o} \binom{\tau _u}{\tau _v }
-\end{equation}
-where $(\tau _u ,\;\tau _v )=(utau,vtau)$ are the two components of the wind 
-stress vector in the $(\textbf{i},\textbf{j})$ coordinate system.
+on the ocean. It is applied in \mdl{dynzdf} module as a surface boundary condition of the 
+computation of the momentum vertical mixing trend (see \eqref{Eq_dynzdf_sbc} in \S\ref{DYN_zdf}).
+As such, it has to be provided as a 2D vector interpolated 
+onto the horizontal velocity ocean mesh, $i.e.$ resolved onto the model 
+(\textbf{i},\textbf{j}) direction at $u$- and $v$-points.
 
 The surface heat flux is decomposed into two parts, a non solar and a solar heat 
 flux, $Q_{ns}$ and $Q_{sr}$, respectively. The former is the non penetrative part 
-of the heat flux ($i.e.$ the sum of sensible, latent and long wave heat fluxes). 
-It is applied as a surface boundary condition trend of the first level temperature 
-time evolution equation (\mdl{trasbc} module). 
-\begin{equation} \label{Eq_sbc_trasbc_q}
-\frac{\partial T}{\partial t}\equiv \cdots \;+\;\left. {\frac{Q_{ns} }{\rho 
-_o \;C_p \;e_{3t} }} \right|_{k=1} \quad
-\end{equation}
-$Q_{sr}$ is the penetrative part of the heat flux. It is applied as a 3D 
-trends of the temperature equation (\mdl{traqsr} module) when \np{ln\_traqsr}=True.
-
-\begin{equation} \label{Eq_sbc_traqsr}
-\frac{\partial T}{\partial t}\equiv \cdots \;+\frac{Q_{sr} }{\rho_o C_p \,e_{3t} }\delta _k \left[ {I_w } \right]
-\end{equation}
-where $I_w$ is a non-dimensional function that describes the way the light 
-penetrates inside the water column. It is generally a sum of decreasing 
-exponentials (see \S\ref{TRA_qsr}).
-
-The surface freshwater budget is provided by fields: \textit{emp} and $\textit{emp}_S$ which 
-may or may not be identical. Indeed, a surface freshwater flux has two effects: 
-it changes the volume of the ocean and it changes the surface concentration of 
-salt (and other tracers). Therefore it appears in the sea surface height as a volume 
-flux, \textit{emp} (\textit{dynspg\_xxx} modules), and in the salinity time evolution equations 
-as a concentration/dilution effect, 
-$\textit{emp}_{S}$ (\mdl{trasbc} module). 
-\begin{equation} \label{Eq_trasbc_emp}
-\begin{aligned}
-&\frac{\partial \eta }{\partial t}\equiv \cdots \;+\;\textit{emp}\quad  \\ 
-\\
- &\frac{\partial S}{\partial t}\equiv \cdots \;+\left. {\frac{\textit{emp}_S \;S}{e_{3t} }} \right|_{k=1} \\ 
- \end{aligned}
-\end{equation} 
-
-In the real ocean, $\textit{emp}=\textit{emp}_S$ and the ocean salt content is conserved, 
-but it exist several numerical reasons why this equality should be broken. 
-For example, when the ocean is coupled to a sea-ice model, the water exchanged between 
-ice and ocean is slightly salty (mean sea-ice salinity is $\sim $\textit{4 psu}). In this case, 
-$\textit{emp}_{S}$ take into account both concentration/dilution effect associated with 
-freezing/melting and the salt flux between ice and ocean, while \textit{emp} is 
-only the volume flux. In addition, in the current version of \NEMO, the sea-ice is 
-assumed to be above the ocean (the so-called levitating sea-ice). Freezing/melting does 
-not change the ocean volume (no impact on \textit{emp}) but it modifies the SSS.
-%gm  \colorbox{yellow}{(see {\S} on LIM sea-ice model)}.
-
-Note that SST can also be modified by a freshwater flux. Precipitation (in 
-particular solid precipitation) may have a temperature significantly different from 
-the SST. Due to the lack of information about the temperature of 
-precipitation, we assume it is equal to the SST. Therefore, no 
-concentration/dilution term appears in the temperature equation. It has to 
-be emphasised that this absence does not mean that there is no heat flux 
-associated with precipitation! Precipitation can change the ocean volume and thus the
-ocean heat content. It is therefore associated with a heat flux (not yet  
-diagnosed in the model) \citep{Roullet_Madec_JGR00}).
+of the heat flux ($i.e.$ the sum of sensible, latent and long wave heat fluxes 
+plus the heat content of the mass exchange with the atmosphere and sea-ice). 
+It is applied in \mdl{trasbc} module as a surface boundary condition trend of 
+the first level temperature time evolution equation (see \eqref{Eq_tra_sbc} 
+and \eqref{Eq_tra_sbc_lin} in \S\ref{TRA_sbc}). 
+The latter is the penetrative part of the heat flux. It is applied as a 3D 
+trends of the temperature equation (\mdl{traqsr} module) when \np{ln\_traqsr}=\textit{true}.
+The way the light penetrates inside the water column is generally a sum of decreasing 
+exponentials (see \S\ref{TRA_qsr}). 
+
+The surface freshwater budget is provided by the \textit{emp} field.
+It represents the mass flux exchanged with the atmosphere (evaporation minus precipitation) 
+and possibly with the sea-ice and ice shelves (freezing minus melting of ice). 
+It affects both the ocean in two different ways: 
+$(i)$   it changes the volume of the ocean and therefore appears in the sea surface height 
+equation as a volume flux, and 
+$(ii)$  it changes the surface temperature and salinity through the heat and salt contents 
+of the mass exchanged with the atmosphere, the sea-ice and the ice shelves. 
+
 
 %\colorbox{yellow}{Miss: }
@@ -152,15 +117,20 @@
 %Sbcmod manage the ``providing'' (fourniture) to the ocean the 7 fields
 %
-%Fluxes update only each nf{\_}sbc time step (namsbc) explain relation 
-%between nf{\_}sbc and nf{\_}ice, do we define nf{\_}blk??? ? only one 
-%nf{\_}sbc
+%Fluxes update only each nn{\_}fsbc time step (namsbc) explain relation 
+%between nn{\_}fsbc and nf{\_}ice, do we define nf{\_}blk??? ? only one 
+%nn{\_}fsbc
 %
 %Explain here all the namlist namsbc variable{\ldots}.
+% 
+% explain : use or not of surface currents
 %
 %\colorbox{yellow}{End Miss }
 
-The ocean model provides the surface currents, temperature and salinity 
-averaged over \np{nf\_sbc} time-step (\ref{Tab_ssm}).The computation of the 
-mean is done in \mdl{sbcmod} module.
+The ocean model provides, at each time step, to the surface module (\mdl{sbcmod}) 
+the surface currents, temperature and salinity.  
+These variables are averaged over \np{nn\_fsbc} time-step (\ref{Tab_ssm}), 
+and it is these averaged fields which are used to computes the surface fluxes 
+at a frequency of \np{nn\_fsbc} time-step.
+
 
 %-------------------------------------------------TABLE---------------------------------------------------
@@ -175,5 +145,5 @@
 \caption{  \label{Tab_ssm}   
 Ocean variables provided by the ocean to the surface module (SBC). 
-The variable are averaged over nf{\_}sbc time step, $i.e.$ the frequency of 
+The variable are averaged over nn{\_}fsbc time step, $i.e.$ the frequency of 
 computation of surface fluxes.}
 \end{center}   \end{table}
@@ -459,15 +429,19 @@
 %--------------------------------------------------------------------------------------------------------------
 
-In some circumstances it may be useful to avoid calculating the 3D temperature, salinity and velocity fields and simply read them in from  a previous run.  
-Options are defined through the  \ngn{namsbc\_sas} namelist variables.
+In some circumstances it may be useful to avoid calculating the 3D temperature, salinity and velocity fields 
+and simply read them in from a previous run or receive them from OASIS.  
 For example:
 
-\begin{enumerate}
-\item  Multiple runs of the model are required in code development to see the affect of different algorithms in
+\begin{itemize}
+\item  Multiple runs of the model are required in code development to see the effect of different algorithms in
        the bulk formulae.
 \item  The effect of different parameter sets in the ice model is to be examined.
-\end{enumerate}
+\item  Development of sea-ice algorithms or parameterizations.
+\item  spinup of the iceberg floats
+\item  ocean/sea-ice simulation with both media running in parallel (\np{ln\_mixcpl}~=~\textit{true})
+\end{itemize}
 
 The StandAlone Surface scheme provides this utility.
+Its options are defined through the \ngn{namsbc\_sas} namelist variables.
 A new copy of the model has to be compiled with a configuration based on ORCA2\_SAS\_LIM.
 However no namelist parameters need be changed from the settings of the previous run (except perhaps nn{\_}date0)
@@ -475,39 +449,33 @@
 Routines replaced are:
 
-\begin{enumerate}
-\item  \mdl{nemogcm}
-
-       This routine initialises the rest of the model and repeatedly calls the stp time stepping routine (step.F90)
+\begin{itemize}
+\item \mdl{nemogcm} : This routine initialises the rest of the model and repeatedly calls the stp time stepping routine (step.F90)
        Since the ocean state is not calculated all associated initialisations have been removed.
-\item  \mdl{step}
-
-       The main time stepping routine now only needs to call the sbc routine (and a few utility functions).
-\item  \mdl{sbcmod}
-
-       This has been cut down and now only calculates surface forcing and the ice model required.  New surface modules
+\item  \mdl{step} : The main time stepping routine now only needs to call the sbc routine (and a few utility functions).
+\item  \mdl{sbcmod} : This has been cut down and now only calculates surface forcing and the ice model required.  New surface modules
        that can function when only the surface level of the ocean state is defined can also be added (e.g. icebergs).
-\item  \mdl{daymod}
-
-       No ocean restarts are read or written (though the ice model restarts are retained), so calls to restart functions
+\item  \mdl{daymod} : No ocean restarts are read or written (though the ice model restarts are retained), so calls to restart functions
        have been removed.  This also means that the calendar cannot be controlled by time in a restart file, so the user
        must make sure that nn{\_}date0 in the model namelist is correct for his or her purposes.
-\item  \mdl{stpctl}
-
-       Since there is no free surface solver, references to it have been removed from \rou{stp\_ctl} module.
-\item  \mdl{diawri}
-
-       All 3D data have been removed from the output.  The surface temperature, salinity and velocity components (which
+\item  \mdl{stpctl} : Since there is no free surface solver, references to it have been removed from \rou{stp\_ctl} module.
+\item  \mdl{diawri} : All 3D data have been removed from the output.  The surface temperature, salinity and velocity components (which
        have been read in) are written along with relevant forcing and ice data.
-\end{enumerate}
+\end{itemize}
 
 One new routine has been added:
 
-\begin{enumerate}
-\item  \mdl{sbcsas}
-       This module initialises the input files needed for reading temperature, salinity and velocity arrays at the surface.
+\begin{itemize}
+\item  \mdl{sbcsas} : This module initialises the input files needed for reading temperature, salinity and velocity arrays at the surface.
        These filenames are supplied in namelist namsbc{\_}sas.  Unfortunately because of limitations with the \mdl{iom} module,
        the full 3D fields from the mean files have to be read in and interpolated in time, before using just the top level.
        Since fldread is used to read in the data, Interpolation on the Fly may be used to change input data resolution.
-\end{enumerate}
+\end{itemize}
+
+
+% Missing the description of the 2 following variables:
+%   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
+
+
 
 % ================================================================
@@ -590,5 +558,5 @@
 reanalysis and satellite data. They use an inertial dissipative method to compute 
 the turbulent transfer coefficients (momentum, sensible heat and evaporation) 
-from the 10 metre wind speed, air temperature and specific humidity.
+from the 10 meters wind speed, air temperature and specific humidity.
 This \citet{Large_Yeager_Rep04} dataset is available through the 
 \href{http://nomads.gfdl.noaa.gov/nomads/forms/mom4/CORE.html}{GFDL web site}. 
@@ -625,4 +593,15 @@
 or larger than the one of the input atmospheric fields.
 
+The  \np{sn\_wndi}, \np{sn\_wndj}, \np{sn\_qsr}, \np{sn\_qlw}, \np{sn\_tair},\np{sn\_humi},\np{sn\_prec}, \np{sn\_snow}, \np{sn\_tdif} parameters describe the fields and the way they have to be used (spatial and temporal interpolations). 
+
+\np{cn\_dir} is the directory of location of bulk files
+\np{ln\_taudif} is the flag to specify if we use Hight Frequency (HF) tau information (.true.) or not (.false.)
+\np{rn\_zqt}: is the height of humidity and temperature measurements (m)
+\np{rn\_zu}: is the height of wind measurements (m)
+The multiplicative factors to activate (value is 1) or deactivate (value is 0) : 
+\np{rn\_pfac} for precipitations (total and snow)
+\np{rn\_efac} for evaporation 
+\np{rn\_vfac} for for ice/ocean velocities in the calculation of wind stress  
+
 % -------------------------------------------------------------------------------------------------------------
 %        CLIO Bulk formulea
@@ -720,7 +699,6 @@
 are sent to the atmospheric component.
 
-A generalised coupled interface has been developed. It is currently interfaced with OASIS 3
-(\key{oasis3}) and does not support OASIS 4
-\footnote{The \key{oasis4} exist. It activates portion of the code that are still under development.}. 
+A generalised coupled interface has been developed. 
+It is currently interfaced with OASIS-3-MCT (\key{oasis3}). 
 It has been successfully used to interface \NEMO to most of the European atmospheric 
 GCM (ARPEGE, ECHAM, ECMWF, HadAM, HadGAM, LMDz), 
@@ -787,12 +765,12 @@
 \label{SBC_tide}
 
-A module is available to use the tidal potential forcing and is activated with with \key{tide}.
-
-
-%------------------------------------------nam_tide----------------------------------------------------
+%------------------------------------------nam_tide---------------------------------------
 \namdisplay{nam_tide}
-%-------------------------------------------------------------------------------------------------------------
-
-Concerning the tidal potential, some parameters are available in namelist \ngn{nam\_tide}:
+%-----------------------------------------------------------------------------------------
+
+A module is available to compute the tidal potential and use it in the momentum equation.
+This option is activated when \key{tide} is defined.
+
+Some parameters are available in namelist \ngn{nam\_tide}:
 
 - \np{ln\_tide\_pot} activate the tidal potential forcing
@@ -801,5 +779,4 @@
 
 - \np{clname} is the name of constituent
-
 
 The tide is generated by the forces of gravity ot the Earth-Moon and Earth-Sun sytem;
@@ -895,4 +872,17 @@
 lowest box the river water is being added to (i.e. the total depth that river water is being added to in the model).
 
+%Christian:
+If the depth information is not provide in the NetCDF file, it can be estimate from the runoff input file at the initial time-step, by setting the namelist parameter \np{ln\_rnf\_depth\_ini} to true.
+
+This estimation is a simple linear relation between the runoff and a given depth : 
+\begin{equation} 
+h\_dep  = \frac{rn\_dep\_max} {rn\_rnf\_max}  rnf
+\end{equation}
+where  \np{rn\_dep\_max} is the given maximum depth over which the runoffs is spread, 
+ \np{rn\_rnf\_max} is the maximum value of the runoff climatologie over the global domain
+and rnf is the maximum value in time of the runoff climatology at each grid cell (computed online).
+
+The estimated depth array can be output if needed in a NetCDF file by setting the namelist parameter \np{nn\_rnf\_depth\_file} to 1.
+
 The mass/volume addition due to the river runoff is, at each relevant depth level, added to the horizontal divergence 
 (\textit{hdivn}) in the subroutine \rou{sbc\_rnf\_div} (called from \mdl{divcur}).
@@ -958,9 +948,49 @@
 \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}, controls the ice shelf representation used (Fig. \ref{Fig_SBC_isf}): 
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!h]    \begin{center}
+\includegraphics[width=0.8\textwidth]{./TexFiles/Figures/Fig_SBC_isf.pdf}
+\caption{ \label{Fig_SBC_isf}
+Schematic for all the options available trough \np{nn\_isf}.}
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
 \begin{description}
+\item[\np{nn\_isf}~=~0]
+The ice shelf routines are not used. The ice shelf melting is not computed or prescribed, the cavity have to be closed. 
+If needed, the ice shelf melting should be added to the runoff or the precipitation file.
+
 \item[\np{nn\_isf}~=~1]
-The ice shelf cavity is represented. The fwf and heat flux are computed. 
-Full description, sensitivity and validation in preparation. 
+The ice shelf cavity is represented. The fwf and heat flux are computed. Two different bulk formula are available:
+	\begin{description}
+	\item[\np{nn\_isfblk}~=~1]
+	The bulk formula used to compute the melt is based the one described in \citet{Hunter2006}.
+        This formulation is based on a balance between the upward ocean heat flux and the latent heat flux at the ice shelf base.
+
+	\item[\np{nn\_isfblk}~=~2] 
+	The bulk formula used to compute the melt is based the one described in \citet{Jenkins1991}.
+        This formulation is based on a 3 equations formulation (a heat flux budget, a salt flux budget and a linearised freezing point temperature equation).
+	\end{description}
+
+For this 2 bulk formulations, there are 3 different ways to compute the exchange coeficient:
+	\begin{description}
+        \item[\np{nn\_gammablk~=~0~}]
+	The salt and heat exchange coefficients are constant and defined by \np{rn\_gammas0} and \np{rn\_gammat0}
+
+	\item[\np{nn\_gammablk~=~1~}]
+	The salt and heat exchange coefficients are velocity dependent and defined as $\np{rn\_gammas0} \times u_{*}$ and $\np{rn\_gammat0} \times u_{*}$
+        where $u_{*}$ is the friction velocity in the top boundary layer (ie first \np{rn\_hisf\_tbl} meters).
+        See \citet{Jenkins2010} for all the details on this formulation.
+	
+	\item[\np{nn\_gammablk~=~2~}]
+	The salt and heat exchange coefficients are velocity and stability dependent and defined as 
+        $\gamma_{T,S} = \frac{u_{*}}{\Gamma_{Turb} + \Gamma^{T,S}_{Mole}}$
+        where $u_{*}$ is the friction velocity in the top boundary layer (ie first \np{rn\_hisf\_tbl} meters), 
+        $\Gamma_{Turb}$ the contribution of the ocean stability and 
+        $\Gamma^{T,S}_{Mole}$ the contribution of the molecular diffusion.
+        See \citet{Holland1999} for all the details on this formulation.
+        \end{description}
 
 \item[\np{nn\_isf}~=~2]
@@ -968,37 +998,56 @@
 The fwf is distributed along the ice shelf edge between the depth of the average grounding line (GL)
 (\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. 
+Furthermore the fwf and heat flux are computed using the \citet{Beckmann2003} parameterisation of isf melting. 
 The effective melting length (\np{sn\_Leff\_isf}) is read from a file.
 
 \item[\np{nn\_isf}~=~3]
 A simple parameterisation of isf is used. The ice shelf cavity is not represented. 
-The fwf (\np{sn\_rnfisf}) is distributed along the ice shelf edge between the depth of the average grounding line (GL)
-(\np{sn\_depmax\_isf}) and the base of the ice shelf along the calving front (\np{sn\_depmin\_isf}).
-Full description, sensitivity and validation in preparation.
+The fwf (\np{sn\_rnfisf}) is prescribed and distributed along the ice shelf edge between the depth of the average grounding line (GL)
+(\np{sn\_depmax\_isf}) and the base of the ice shelf along the calving front (\np{sn\_depmin\_isf}). 
+The heat flux ($Q_h$) is computed as $Q_h = fwf \times L_f$.
 
 \item[\np{nn\_isf}~=~4]
-The ice shelf cavity is represented. However, the fwf (\np{sn\_fwfisf}) and heat flux (\np{sn\_qisf}) are 
-not computed but specified from file. 
+The ice shelf cavity is opened. However, the fwf is not computed but specified from file \np{sn\_fwfisf}). 
+The heat flux ($Q_h$) is computed as $Q_h = fwf \times L_f$.\\
 \end{description}
 
-\np{nn\_isf}~=~1 and \np{nn\_isf}~=~2 compute a melt rate based on the water masse properties, ocean velocities and depth.
- This flux is thus highly dependent of the model resolution (horizontal and vertical), realism of the water masse onto the shelf ...
-
-\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 
-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}). 
+
+$\bullet$ \np{nn\_isf}~=~1 and \np{nn\_isf}~=~2 compute a melt rate based on the water mass properties, ocean velocities and depth.
+ This flux is thus highly dependent of the model resolution (horizontal and vertical), realism of the water masses onto the shelf ...\\
+
+$\bullet$ \np{nn\_isf}~=~3 and \np{nn\_isf}~=~4 read the melt rate from a file. You have total control of the fwf forcing.
+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 studies where you need to control your heat and fw input.\\ 
+
+Two namelist parameters control how the heat and fw fluxes are passed to NEMO: \np{rn\_hisf\_tbl} and \np{ln\_divisf}
+\begin{description}
+\item[\np{rn\_hisf\_tbl}] is the top boundary layer thickness as defined in \citet{Losch2008}. 
+This parameter is only used if \np{nn\_isf}~=~1 or \np{nn\_isf}~=~4
+It allows you to control over which depth you want to spread the heat and fw fluxes. 
+
+If \np{rn\_hisf\_tbl} = 0.0, the fluxes are put in the top level whatever is its tickness. 
+
+If \np{rn\_hisf\_tbl} $>$ 0.0, the fluxes are spread over the first \np{rn\_hisf\_tbl} m (ie over one or several cells).
+
+\item[\np{ln\_divisf}] is a flag to apply the fw flux as a volume flux or as a salt flux. 
+
+\np{ln\_divisf}~=~true applies the fwf as a volume flux. This volume flux is implemented with in the same way as for the runoff.
+The fw 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}. 
+See the runoff section \ref{SBC_rnf} for all the details about the divergence correction. 
+
+\np{ln\_divisf}~=~false applies the fwf and heat flux directly on the salinity and temperature tendancy.
+
+\item[\np{ln\_conserve}] is a flag for \np{nn\_isf}~=~1. A conservative boundary layer scheme as described in \citet{Jenkins2001} 
+is used if \np{ln\_conserve}=true. It takes into account the fact that the melt water is at freezing T and needs to be warm up to ocean temperature. 
+It is only relevant for \np{ln\_divisf}~=~false. 
+If \np{ln\_divisf}~=~true, \np{ln\_conserve} has to be set to false to avoid a double counting of the contribution. 
+ 
+\end{description}
 %
 % ================================================================
 %        Handling of icebergs
 % ================================================================
-\section{ Handling of icebergs (ICB) }
+\section{Handling of icebergs (ICB)}
 \label{ICB_icebergs}
 %------------------------------------------namberg----------------------------------------------------
@@ -1006,8 +1055,9 @@
 %-------------------------------------------------------------------------------------------------------------
 
-Icebergs are modelled as lagrangian particles in NEMO.
-Their physical behaviour is controlled by equations as described in  \citet{Martin_Adcroft_OM10} ).
-(Note that the authors kindly provided a copy of their code to act as a basis for implementation in NEMO.)
-Icebergs are initially spawned into one of ten classes which have specific mass and thickness as described in the \ngn{namberg} namelist: 
+Icebergs are modelled as lagrangian particles in NEMO \citep{Marsh_GMD2015}.
+Their physical behaviour is controlled by equations as described in \citet{Martin_Adcroft_OM10} ).
+(Note that the authors kindly provided a copy of their code to act as a basis for implementation in NEMO).
+Icebergs are initially spawned into one of ten classes which have specific mass and thickness as described 
+in the \ngn{namberg} namelist: 
 \np{rn\_initial\_mass} and \np{rn\_initial\_thickness}.
 Each class has an associated scaling (\np{rn\_mass\_scaling}), which is an integer representing how many icebergs 
@@ -1193,5 +1243,5 @@
 The presence at the sea surface of an ice covered area modifies all the fluxes 
 transmitted to the ocean. There are several way to handle sea-ice in the system 
-depending on the value of the \np{nn{\_}ice} namelist parameter.  
+depending on the value of the \np{nn\_ice} namelist parameter found in \ngn{namsbc} namelist.  
 \begin{description}
 \item[nn{\_}ice = 0]  there will never be sea-ice in the computational domain. 
@@ -1268,27 +1318,41 @@
 % -------------------------------------------------------------------------------------------------------------
 \subsection   [Neutral drag coefficient from external wave model (\textit{sbcwave})]
-                        {Neutral drag coefficient from external wave model (\mdl{sbcwave})}
+              {Neutral drag coefficient from external wave model (\mdl{sbcwave})}
 \label{SBC_wave}
 %------------------------------------------namwave----------------------------------------------------
 \namdisplay{namsbc_wave}
 %-------------------------------------------------------------------------------------------------------------
-\begin{description}
-
-\item [??] In order to read a neutral drag coeff, from an external data source (i.e. a wave model), the 
-logical variable \np{ln\_cdgw}
- in $namsbc$ namelist must be defined ${.true.}$. 
+
+In order to read a neutral drag coeff, from an external data source ($i.e.$ a wave model), the 
+logical variable \np{ln\_cdgw} in \ngn{namsbc} namelist must be set to \textit{true}. 
 The \mdl{sbcwave} module containing the routine \np{sbc\_wave} reads the
 namelist \ngn{namsbc\_wave} (for external data names, locations, frequency, interpolation and all 
 the miscellanous options allowed by Input Data generic Interface see \S\ref{SBC_input}) 
-and a 2D field of neutral drag coefficient. Then using the routine 
-TURB\_CORE\_1Z or TURB\_CORE\_2Z, and starting from the neutral drag coefficent provided, the drag coefficient is computed according 
-to stable/unstable conditions of the air-sea interface following \citet{Large_Yeager_Rep04}.
-
-\end{description}
+and a 2D field of neutral drag coefficient. 
+Then using the routine TURB\_CORE\_1Z or TURB\_CORE\_2Z, and starting from the neutral drag coefficent provided, 
+the drag coefficient is computed according to stable/unstable conditions of the air-sea interface following \citet{Large_Yeager_Rep04}.
+
 
 % Griffies doc:
-% When running ocean-ice simulations, we are not explicitly representing land processes, such as rivers, catchment areas, snow accumulation, etc. However, to reduce model drift, it is important to balance the hydrological cycle in ocean-ice models. We thus need to prescribe some form of global normalization to the precipitation minus evaporation plus river runoff. The result of the normalization should be a global integrated zero net water input to the ocean-ice system over a chosen time scale. 
-%How often the normalization is done is a matter of choice. In mom4p1, we choose to do so at each model time step, so that there is always a zero net input of water to the ocean-ice system. Others choose to normalize over an annual cycle, in which case the net imbalance over an annual cycle is used to alter the subsequent year�s water budget in an attempt to damp the annual water imbalance. Note that the annual budget approach may be inappropriate with interannually varying precipitation forcing. 
-%When running ocean-ice coupled models, it is incorrect to include the water transport between the ocean and ice models when aiming to balance the hydrological cycle. The reason is that it is the sum of the water in the ocean plus ice that should be balanced when running ocean-ice models, not the water in any one sub-component. As an extreme example to illustrate the issue, consider an ocean-ice model with zero initial sea ice. As the ocean-ice model spins up, there should be a net accumulation of water in the growing sea ice, and thus a net loss of water from the ocean. The total water contained in the ocean plus ice system is constant, but there is an exchange of water between the subcomponents. This exchange should not be part of the normalization used to balance the hydrological cycle in ocean-ice models. 
-
-
+% When running ocean-ice simulations, we are not explicitly representing land processes, 
+% such as rivers, catchment areas, snow accumulation, etc. However, to reduce model drift, 
+% it is important to balance the hydrological cycle in ocean-ice models. 
+% We thus need to prescribe some form of global normalization to the precipitation minus evaporation plus river runoff. 
+% The result of the normalization should be a global integrated zero net water input to the ocean-ice system over 
+% a chosen time scale. 
+%How often the normalization is done is a matter of choice. In mom4p1, we choose to do so at each model time step, 
+% so that there is always a zero net input of water to the ocean-ice system. 
+% Others choose to normalize over an annual cycle, in which case the net imbalance over an annual cycle is used 
+% to alter the subsequent year�s water budget in an attempt to damp the annual water imbalance. 
+% Note that the annual budget approach may be inappropriate with interannually varying precipitation forcing. 
+% When running ocean-ice coupled models, it is incorrect to include the water transport between the ocean 
+% and ice models when aiming to balance the hydrological cycle. 
+% The reason is that it is the sum of the water in the ocean plus ice that should be balanced when running ocean-ice models, 
+% not the water in any one sub-component. As an extreme example to illustrate the issue, 
+% consider an ocean-ice model with zero initial sea ice. As the ocean-ice model spins up, 
+% there should be a net accumulation of water in the growing sea ice, and thus a net loss of water from the ocean. 
+% The total water contained in the ocean plus ice system is constant, but there is an exchange of water between 
+% the subcomponents. This exchange should not be part of the normalization used to balance the hydrological cycle 
+% in ocean-ice models. 
+
+
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_STO.tex
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_STO.tex	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_STO.tex	(revision 6440)
@@ -5,7 +5,154 @@
 \label{STO}
 
+Authors: P.-A. Bouttier
+
 \minitoc
-
 
 \newpage
 $\ $\newline    % force a new line
+
+The stochastic parametrization module aims to explicitly simulate uncertainties in the model. More particularly, \cite{Brankart_OM2013} has shown that, because of the nonlinearity of the seawater equation of state, unresolved scales represent a major source of uncertainties in the computation of the large scale horizontal density gradient (from T/S large scale fields), and that the impact of these uncertainties can be simulated by random processes representing unresolved T/S fluctuations.
+
+The stochastic formulation of the equation of state can be written as:
+\begin{equation}
+ \label{eq:eos_sto}
+  \rho = \frac{1}{2} \sum_{i=1}^m\{ \rho[T+\Delta T_i,S+\Delta S_i,p_o(z)] + \rho[T-\Delta T_i,S-\Delta S_i,p_o(z)] \}
+\end{equation}
+where $p_o(z)$ is the reference pressure depending on the depth and $\Delta T_i$ and $\Delta S_i$ are a set of T/S perturbations defined as the scalar product of the respective local T/S gradients with random walks $\mathbf{\xi}$:
+\begin{equation}
+ \label{eq:sto_pert}
+ \Delta T_i = \mathbf{\xi}_i \cdot \nabla T \qquad \hbox{and} \qquad \Delta S_i = \mathbf{\xi}_i \cdot \nabla S
+\end{equation}
+$\mathbf{\xi}_i$ are produced by a first-order autoregressive processes (AR-1) with a parametrized decorrelation time scale, and horizontal and vertical standard deviations $\sigma_s$. $\mathbf{\xi}$ are uncorrelated over the horizontal and fully correlated along the vertical.
+
+
+\section{Stochastic processes}
+\label{STO_the_details}
+
+The starting point of our implementation of stochastic parameterizations
+in NEMO is to observe that many existing parameterizations are based
+on autoregressive processes, which are used as a basic source of randomness
+to transform a deterministic model into a probabilistic model.
+A generic approach is thus to add one single new module in NEMO,
+generating processes with appropriate statistics
+to simulate each kind of uncertainty in the model
+(see \cite{Brankart_al_GMD2015} for more details).
+
+In practice, at every model grid point, independent Gaussian autoregressive
+processes~$\xi^{(i)},\,i=1,\ldots,m$ are first generated
+using the same basic equation:
+
+\begin{equation}
+\label{eq:autoreg}
+\xi^{(i)}_{k+1} = a^{(i)} \xi^{(i)}_k + b^{(i)} w^{(i)} + c^{(i)}
+\end{equation}
+
+\noindent
+where $k$ is the index of the model timestep; and
+$a^{(i)}$, $b^{(i)}$, $c^{(i)}$ are parameters defining
+the mean ($\mu^{(i)}$) standard deviation ($\sigma^{(i)}$)
+and correlation timescale ($\tau^{(i)}$) of each process:
+
+\begin{itemize}
+\item for order~1 processes, $w^{(i)}$ is a Gaussian white noise,
+with zero mean and standard deviation equal to~1, and the parameters
+$a^{(i)}$, $b^{(i)}$, $c^{(i)}$ are given by:
+
+\begin{equation}
+\label{eq:ord1}
+\left\{
+\begin{array}{l}
+a^{(i)} = \varphi \\
+b^{(i)} = \sigma^{(i)} \sqrt{ 1 - \varphi^2 } 
+ \qquad\qquad\mbox{with}\qquad\qquad
+\varphi = \exp \left( - 1 / \tau^{(i)} \right) \\
+c^{(i)} = \mu^{(i)} \left( 1 - \varphi \right) \\
+\end{array}
+\right.
+\end{equation}
+
+\item for order~$n>1$ processes, $w^{(i)}$ is an order~$n-1$ autoregressive process,
+with zero mean, standard deviation equal to~$\sigma^{(i)}$; correlation timescale
+equal to~$\tau^{(i)}$; and the parameters
+$a^{(i)}$, $b^{(i)}$, $c^{(i)}$ are given by:
+
+\begin{equation}
+\label{eq:ord2}
+\left\{
+\begin{array}{l}
+a^{(i)} = \varphi \\
+b^{(i)} = \frac{n-1}{2(4n-3)} \sqrt{ 1 - \varphi^2 } 
+ \qquad\qquad\mbox{with}\qquad\qquad
+\varphi = \exp \left( - 1 / \tau^{(i)} \right) \\
+c^{(i)} = \mu^{(i)} \left( 1 - \varphi \right) \\
+\end{array}
+\right.
+\end{equation}
+
+\end{itemize}
+
+\noindent
+In this way, higher order processes can be easily generated recursively using the same piece of code implementing Eq.~(\ref{eq:autoreg}), and using succesively processes from order $0$ to~$n-1$ as~$w^{(i)}$.
+The parameters in Eq.~(\ref{eq:ord2}) are computed so that this recursive application
+of Eq.~(\ref{eq:autoreg}) leads to processes with the required standard deviation
+and correlation timescale, with the additional condition that
+the $n-1$ first derivatives of the autocorrelation function
+are equal to zero at~$t=0$, so that the resulting processes
+become smoother and smoother as $n$ is increased.
+
+Overall, this method provides quite a simple and generic way of generating a wide class of stochastic processes. However, this also means that new model parameters are needed to specify each of these stochastic processes. As in any parameterization of lacking physics, a very important issues then to tune these new parameters using either first principles, model simulations, or real-world observations.
+
+\section{Implementation details}
+\label{STO_thech_details}
+The computer code implementing stochastic parametrisations is made of one single FORTRAN module,
+with 3 public routines to be called by the model (in our case, NEMO):
+
+The first routine ({sto\_par}) is a direct implementation of Eq.~(\ref{eq:autoreg}),
+applied at each model grid point (in 2D or 3D),
+and called at each model time step ($k$) to update
+every autoregressive process ($i=1,\ldots,m$).
+This routine also includes a filtering operator, applied to $w^{(i)}$,
+to introduce a spatial correlation between the stochastic processes.
+
+The second routine ({sto\_par\_init})
+is an initialization routine mainly dedicated
+to the computation of parameters $a^{(i)}, b^{(i)}, c^{(i)}$
+for each autoregressive process, as a function of the statistical properties
+required by the model user (mean, standard deviation, time correlation,
+order of the process,\ldots). Parameters for the processes can be specified through the following namelist parameters:
+\begin{alltt}
+\tiny
+\begin{verbatim}
+   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)
+\end{verbatim}
+\end{alltt}
+This routine also includes the initialization (seeding)
+of the random number generator.
+
+The third routine ({sto\_rst\_write}) writes a ``restart file''
+with the current value of all autoregressive processes
+to allow restarting a simulation from where it has been interrupted.
+This file also contains the current state of the random number generator.
+In case of a restart, this file is then read by the initialization routine
+({sto\_par\_init}), so that the simulation can continue exactly
+as if it was not interrupted.
+Restart capabilities of the module are driven by the following namelist parameters:
+\begin{alltt}
+\tiny
+\begin{verbatim}
+   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)
+\end{verbatim}
+\end{alltt}
+
+In the particular case of the stochastic equation of state, there is also an additional module ({sto\_pts}) implementing Eq~\ref{eq:sto_pert} and specific piece of code in the equation of state implementing Eq~\ref{eq:eos_sto}.
+
+
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_TRA.tex
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_TRA.tex	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_TRA.tex	(revision 6440)
@@ -1,4 +1,4 @@
 % ================================================================
-% Chapter 1 � Ocean Tracers (TRA)
+% Chapter 1 ——— Ocean Tracers (TRA)
 % ================================================================
 \chapter{Ocean Tracers (TRA)}
@@ -36,16 +36,14 @@
 (BBL) parametrisation, and an internal damping (DMP) term. The terms QSR, 
 BBC, BBL and DMP are optional. The external forcings and parameterisations 
-require complex inputs and complex calculations (e.g. bulk formulae, estimation 
+require complex inputs and complex calculations ($e.g.$ bulk formulae, estimation 
 of mixing coefficients) that are carried out in the SBC, LDF and ZDF modules and 
 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}
-%%%
+Note that \mdl{tranpc}, the non-penetrative convection module, although 
+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 
-the sea-water properties (density, Brunt-Vais\"{a}l\"{a} frequency, specific heat and 
+the sea-water properties (density, Brunt-V\"{a}is\"{a}l\"{a} frequency, specific heat and 
 freezing point with associated modules \mdl{eosbn2} and \mdl{phycst}).
 
@@ -56,6 +54,6 @@
 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}.
+The user has the option of extracting each tendency term on the RHS of the tracer 
+equation for output (\np{ln\_tra\_trd} or \np{ln\_tra\_mxl}~=~true), as described in Chap.~\ref{DIA}.
 
 $\ $\newline    % force a new ligne
@@ -125,7 +123,7 @@
 \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}, 
@@ -133,7 +131,8 @@
 
 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.
+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}).
 
 The choice of an advection scheme is made in the \textit{\ngn{nam\_traadv}} namelist, by 
@@ -146,8 +145,8 @@
 
 Note that 
-(1) cen2, cen4 and TVD schemes require an explicit diffusion 
+(1) cen2 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
+(2) cen2, MUSCL2, and UBS are not \textit{positive} schemes
 \footnote{negative values can appear in an initially strictly positive tracer field 
 which is advected}
@@ -189,5 +188,5 @@
 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 
+configuration only. This is an obsolescent feature as the recommended 
 advection scheme for the ORCA configuration is TVD (see  \S\ref{TRA_adv_tvd}).
 
@@ -196,41 +195,4 @@
 have this order of accuracy. \gmcomment{Note also that ... blah, blah}
 
-% -------------------------------------------------------------------------------------------------------------
-%        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:
-\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 
-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.  
-
-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.
 
 % -------------------------------------------------------------------------------------------------------------
@@ -270,4 +232,12 @@
 used for the diffusive part. 
 
+An additional option has been added controlled by \np{ln\_traadv\_tvd\_zts}. 
+By setting this logical to true, a TVD scheme is used on both horizontal and vertical direction, 
+but on the latter, a split-explicit time stepping is used, with 5 sub-timesteps. 
+This option can be useful when the value 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 ensure a better stability (see \np{ln\_dynzad\_zts} in \S\ref{DYN_zad}).
+
+
 % -------------------------------------------------------------------------------------------------------------
 %        MUSCL scheme  
@@ -296,10 +266,12 @@
 
 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, 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.
+
+Note that when using np{ln\_traadv\_msc\_ups}~=~true in addition to \np{ln\_traadv\_muscl}=true, 
+the MUSCL fluxes are replaced by upstream fluxes in vicinity of river mouths.
 
 % -------------------------------------------------------------------------------------------------------------
@@ -416,18 +388,4 @@
 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.
 
 % ================================================================
@@ -464,5 +422,5 @@
 surfaces is given by: 
 \begin{equation} \label{Eq_tra_ldf_lap}
-D_T^{lT} =\frac{1}{b_tT} \left( \;
+D_T^{lT} =\frac{1}{b_t} \left( \;
    \delta _{i}\left[ A_u^{lT} \; \frac{e_{2u}\,e_{3u}}{e_{1u}} \;\delta _{i+1/2} [T] \right] 
 + \delta _{j}\left[ A_v^{lT} \;  \frac{e_{1v}\,e_{3v}}{e_{2v}} \;\delta _{j+1/2} [T] \right]  \;\right)
@@ -661,16 +619,10 @@
 the thickness of the top model layer. 
 
-Due to interactions and mass exchange of water ($F_{mass}$) with other Earth system components ($i.e.$ atmosphere, sea-ice, land),
-the change in the heat and salt content of the surface layer of the ocean is due both 
-to the heat and salt fluxes crossing the sea surface (not linked with $F_{mass}$)
- and to the heat and salt content of the mass exchange.
-\sgacomment{ the following does not apply to the release to which this documentation is 
-attached and so should not be included ....
-In a forthcoming release, these two parts, computed in the surface module (SBC), will be included directly
-in $Q_{ns}$, the surface heat flux and $F_{salt}$, the surface salt flux.
-The specification of these fluxes is further detailed in the SBC chapter (see \S\ref{SBC}). 
-This change will provide a forcing formulation which is the same for any tracer (including temperature and salinity).
- 
-In the current version, the situation is a little bit more complicated. }
+Due to interactions and mass exchange of water ($F_{mass}$) with other Earth system components 
+($i.e.$ atmosphere, sea-ice, land), the change in the heat and salt content of the surface layer 
+of the ocean is due both to the heat and salt fluxes crossing the sea surface (not linked with $F_{mass}$) 
+and to the heat and salt content of the mass exchange. They are both included directly in $Q_{ns}$, 
+the surface heat flux, and $F_{salt}$, the surface salt flux (see \S\ref{SBC} for further details).
+By doing this, the forcing formulation is the same for any tracer (including temperature and salinity).
 
 The surface module (\mdl{sbcmod}, see \S\ref{SBC}) provides the following 
@@ -679,22 +631,37 @@
 $\bullet$ $Q_{ns}$, the non-solar part of the net surface heat flux that crosses the sea surface 
 (i.e. the difference between the total surface heat flux and the fraction of the short wave flux that 
-penetrates into the water column, see \S\ref{TRA_qsr})
-
-$\bullet$ \textit{emp}, the mass flux exchanged with the atmosphere (evaporation minus precipitation)
-
-$\bullet$ $\textit{emp}_S$, an equivalent mass flux taking into account the effect of ice-ocean mass exchange
-
-$\bullet$ \textit{rnf}, the mass flux associated with runoff (see \S\ref{SBC_rnf} for further detail of how it acts on temperature and salinity tendencies)
-
-The $\textit{emp}_S$ field is not simply the budget of evaporation-precipitation+freezing-melting because 
-the sea-ice is not currently embedded in the ocean but levitates above it. There is no mass
-exchanged between the sea-ice and the ocean. Instead we only take into account the salt
-flux associated with the non-zero salinity of sea-ice, and the concentration/dilution effect
-due to the freezing/melting (F/M) process. These two parts of the forcing are then converted into 
-an equivalent mass flux given by $\textit{emp}_S - \textit{emp}$. As a result of this mess, 
-the surface boundary condition on temperature and salinity is applied as follows:
-
-In the nonlinear free surface case (\key{vvl} is defined):
+penetrates into the water column, see \S\ref{TRA_qsr}) plus the heat content associated with 
+of the mass exchange with the atmosphere and lands.
+
+$\bullet$ $\textit{sfx}$, the salt flux resulting from ice-ocean mass exchange (freezing, melting, ridging...)
+
+$\bullet$ \textit{emp}, the mass flux exchanged with the atmosphere (evaporation minus precipitation) 
+ and possibly with the sea-ice and ice-shelves.
+
+$\bullet$ \textit{rnf}, the mass flux associated with runoff 
+(see \S\ref{SBC_rnf} for further detail of how it acts on temperature and salinity tendencies)
+
+$\bullet$ \textit{fwfisf}, the mass flux associated with ice shelf melt, (see \S\ref{SBC_isf} for further details 
+on how the ice shelf melt is computed and applied).\\
+
+In the non-linear free surface case (\key{vvl} is defined), the surface boundary condition 
+on temperature and salinity is applied as follows:
 \begin{equation} \label{Eq_tra_sbc}
+\begin{aligned}
+ &F^T = \frac{ 1 }{\rho _o \;C_p \,\left. e_{3t} \right|_{k=1} }  &\overline{ Q_{ns}       }^t  & \\ 
+& F^S =\frac{ 1 }{\rho _o  \,      \left. e_{3t} \right|_{k=1} }  &\overline{ \textit{sfx} }^t   & \\   
+ \end{aligned}
+\end{equation} 
+where $\overline{x }^t$ means that $x$ is averaged over two consecutive time steps 
+($t-\rdt/2$ and $t+\rdt/2$). Such time averaging prevents the 
+divergence of odd and even time step (see \S\ref{STP}).
+
+In the linear free surface case (\key{vvl} is \textit{not} defined), 
+an additional term has to be added on both temperature and salinity. 
+On temperature, this term remove the heat content associated with mass exchange
+that has been added to $Q_{ns}$. On salinity, this term mimics the concentration/dilution effect that
+would have resulted from a change in the volume of the first level.
+The resulting surface boundary condition is applied as follows:
+\begin{equation} \label{Eq_tra_sbc_lin}
 \begin{aligned}
  &F^T = \frac{ 1 }{\rho _o \;C_p \,\left. e_{3t} \right|_{k=1} }   
@@ -702,50 +669,11 @@
 %
 & F^S =\frac{ 1 }{\rho _o \,\left. e_{3t} \right|_{k=1} } 
-           &\overline{ \left( (\textit{emp}_S - \textit{emp})\;\left. S \right|_{k=1}  \right) }^t   & \\   
+           &\overline{ \left( \;\textit{sfx} - \textit{emp} \;\left. S \right|_{k=1}  \right) }^t   & \\   
  \end{aligned}
 \end{equation} 
-
-In the linear free surface case (\key{vvl} not defined):
-\begin{equation} \label{Eq_tra_sbc_lin}
-\begin{aligned}
- &F^T = \frac{ 1 }{\rho _o \;C_p \,\left. e_{3t} \right|_{k=1} }  &\overline{ Q_{ns} }^t  & \\ 
-%
-& F^S =\frac{ 1 }{\rho _o \,\left. e_{3t} \right|_{k=1} } 
-           &\overline{ \left( \textit{emp}_S\;\left. S \right|_{k=1}  \right) }^t   & \\   
- \end{aligned}
-\end{equation} 
-where $\overline{x }^t$ means that $x$ is averaged over two consecutive time steps 
-($t-\rdt/2$ and $t+\rdt/2$). Such time averaging prevents the 
-divergence of odd and even time step (see \S\ref{STP}).
-
-The two set of equations, \eqref{Eq_tra_sbc} and \eqref{Eq_tra_sbc_lin}, are obtained 
-by assuming that the temperature of precipitation and evaporation are equal to
-the ocean surface temperature and that their salinity is zero. Therefore, the heat content
-of the \textit{emp} budget must be added to the temperature equation in the variable volume case, 
-while it does not appear in the constant volume case. Similarly, the \textit{emp} budget affects 
-the ocean surface salinity in the constant volume case (through the concentration dilution effect)
-while it does not appears explicitly in the variable volume case since salinity change will be
-induced by volume change. In both constant and variable volume cases, surface salinity 
-will change with ice-ocean salt flux and F/M flux (both contained in $\textit{emp}_S - \textit{emp}$) without mass exchanges.
-
-Note that the concentration/dilution effect due to F/M is computed using
-a constant ice salinity as well as a constant ocean salinity. 
-This approximation suppresses the correlation between \textit{SSS} 
-and F/M flux, allowing the ice-ocean salt exchanges to be conservative.
-Indeed, if this approximation is not made, even if the F/M budget is zero 
-on average over the whole ocean domain and over the seasonal cycle, 
-the associated salt flux is not zero, since sea-surface salinity and F/M flux are 
-intrinsically correlated (high \textit{SSS} are found where freezing is 
-strong whilst low \textit{SSS} is usually associated with high melting areas).
-
-Even using this approximation, an exact conservation of heat and salt content 
-is only achieved in the variable volume case. In the constant volume case, 
-there is a small imbalance associated with the product $(\partial_t\eta - \textit{emp}) * \textit{SSS}$.
-Nevertheless, the salt content variation is quite small and will not induce
-a long term drift as there is no physical reason for $(\partial_t\eta - \textit{emp})$ 
-and \textit{SSS} to be correlated \citep{Roullet_Madec_JGR00}. 
-Note that, while quite small, the imbalance in the constant volume case is larger 
+Note that an exact conservation of heat and salt content is only achieved with non-linear free surface. 
+In the linear free surface case, there is a small imbalance. The imbalance is larger 
 than the imbalance associated with the Asselin time filter \citep{Leclair_Madec_OM09}. 
-This is the reason why the modified filter is not applied in the constant volume case.
+This is the reason why the modified filter is not applied in the linear free surface case (see \S\ref{STP}).
 
 % -------------------------------------------------------------------------------------------------------------
@@ -821,11 +749,19 @@
 ($i.e.$ the inverses of the extinction length scales) are tabulated over 61 nonuniform 
 chlorophyll classes ranging from 0.01 to 10 g.Chl/L (see the routine \rou{trc\_oce\_rgb} 
-in \mdl{trc\_oce} module). Three types of chlorophyll can be chosen in the RGB formulation:
-(1) a constant 0.05 g.Chl/L value everywhere (\np{nn\_chdta}=0) ; (2) an observed 
-time varying chlorophyll (\np{nn\_chdta}=1) ; (3) simulated time varying chlorophyll
-by TOP biogeochemical model (\np{ln\_qsr\_bio}=true). In the latter case, the RGB 
-formulation is used to calculate both the phytoplankton light limitation in PISCES 
-or LOBSTER and the oceanic heating rate. 
-
+in \mdl{trc\_oce} module). Four types of chlorophyll can be chosen in the RGB formulation:
+\begin{description} 
+\item[\np{nn\_chdta}=0] 
+a constant 0.05 g.Chl/L value everywhere ; 
+\item[\np{nn\_chdta}=1]  
+an observed time varying chlorophyll deduced from satellite surface ocean color measurement 
+spread uniformly in the vertical direction ; 
+\item[\np{nn\_chdta}=2]  
+same as previous case except that a vertical profile of chlorophyl is used. 
+Following \cite{Morel_Berthon_LO89}, the profile is computed from the local surface chlorophyll value ;
+\item[\np{ln\_qsr\_bio}=true]  
+simulated time varying chlorophyll by TOP biogeochemical model. 
+In this case, the RGB formulation is used to calculate both the phytoplankton 
+light limitation in PISCES or LOBSTER and the oceanic heating rate. 
+\end{description} 
 The trend in \eqref{Eq_tra_qsr} associated with the penetration of the solar radiation 
 is added to the temperature trend, and the surface heat flux is modified in routine \mdl{traqsr}. 
@@ -859,5 +795,5 @@
 \label{TRA_bbc}
 %--------------------------------------------nambbc--------------------------------------------------------
-\namdisplay{namtra_bbc}
+\namdisplay{nambbc}
 %--------------------------------------------------------------------------------------------------------------
 %>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -1103,5 +1039,10 @@
 \subsection[DMP\_TOOLS]{Generating resto.nc using DMP\_TOOLS}
 
-DMP\_TOOLS can be used to generate a netcdf file containing the restoration coefficient $\gamma$. Note that in order to maintain bit comparison with previous NEMO versions DMP\_TOOLS must be compiled and run on the same machine as the NEMO model. A mesh\_mask.nc file for the model configuration is required as an input. This can be generated by carrying out a short model run with the namelist parameter \np{nn\_msh} set to 1. The namelist parameter \np{ln\_tradmp} will also need to be set to .false. for this to work. The \nl{nam\_dmp\_create} namelist in the DMP\_TOOLS directory is used to specify options for the restoration coefficient.
+DMP\_TOOLS can be used to generate a netcdf file containing the restoration coefficient $\gamma$. 
+Note that in order to maintain bit comparison with previous NEMO versions DMP\_TOOLS must be compiled 
+and run on the same machine as the NEMO model. A mesh\_mask.nc file for the model configuration is required as an input. 
+This can be generated by carrying out a short model run with the namelist parameter \np{nn\_msh} set to 1. 
+The namelist parameter \np{ln\_tradmp} will also need to be set to .false. for this to work. 
+The \nl{nam\_dmp\_create} namelist in the DMP\_TOOLS directory is used to specify options for the restoration coefficient.
 
 %--------------------------------------------nam_dmp_create-------------------------------------------------
@@ -1111,7 +1052,23 @@
 \np{cp\_cfg}, \np{cp\_cpz}, \np{jp\_cfg} and \np{jperio} specify the model configuration being used and should be the same as specified in \nl{namcfg}. The variable \nl{lzoom} is used to specify that the damping is being used as in case \textit{a} above to provide boundary conditions to a zoom configuration. In the case of the arctic or antarctic zoom configurations this includes some specific treatment. Otherwise damping is applied to the 6 grid points along the ocean boundaries. The open boundaries are specified by the variables \np{lzoom\_n}, \np{lzoom\_e}, \np{lzoom\_s}, \np{lzoom\_w} in the \nl{nam\_zoom\_dmp} name list.
 
-The remaining switch namelist variables determine the spatial variation of the restoration coefficient in non-zoom configurations. \np{ln\_full\_field} specifies that newtonian damping should be applied to the whole model domain. \np{ln\_med\_red\_seas} specifies grid specific restoration coefficients in the Mediterranean Sea for the ORCA4, ORCA2 and ORCA05 configurations. If \np{ln\_old\_31\_lev\_code} is set then the depth variation of the coeffients will be specified as a function of the model number. This option is included to allow backwards compatability of the ORCA2 reference configurations with previous model versions. \np{ln\_coast} specifies that the restoration coefficient should be reduced near to coastlines. This option only has an effect if \np{ln\_full\_field} is true. \np{ln\_zero\_top\_layer} specifies that the restoration coefficient should be zero in the surface layer. Finally \np{ln\_custom} specifies that the custom module will be called. This module is contained in the file custom.F90 and can be edited by users. For example damping could be applied in a specific region.
-
-The restoration coefficient can be set to zero in equatorial regions by specifying a positive value of \np{nn\_hdmp}. Equatorward of this latitude the restoration coefficient will be zero with a smooth transition to the full values of a 10$^{\circ}$ latitud band. This is often used because of the short adjustment time scale in the equatorial region \citep{Reverdin1991, Fujio1991, Marti_PhD92}. The time scale associated with the damping depends on the depth as a hyperbolic tangent, with \np{rn\_surf} as surface value, \np{rn\_bot} as bottom value and a transition depth of \np{rn\_dep}.  
+The remaining switch namelist variables determine the spatial variation of the restoration coefficient in non-zoom configurations. 
+\np{ln\_full\_field} specifies that newtonian damping should be applied to the whole model domain. 
+\np{ln\_med\_red\_seas} specifies grid specific restoration coefficients in the Mediterranean Sea 
+for the ORCA4, ORCA2 and ORCA05 configurations. 
+If \np{ln\_old\_31\_lev\_code} is set then the depth variation of the coeffients will be specified as 
+a function of the model number. This option is included to allow backwards compatability of the ORCA2 reference 
+configurations with previous model versions. 
+\np{ln\_coast} specifies that the restoration coefficient should be reduced near to coastlines. 
+This option only has an effect if \np{ln\_full\_field} is true. 
+\np{ln\_zero\_top\_layer} specifies that the restoration coefficient should be zero in the surface layer. 
+Finally \np{ln\_custom} specifies that the custom module will be called. 
+This module is contained in the file custom.F90 and can be edited by users. For example damping could be applied in a specific region.
+
+The restoration coefficient can be set to zero in equatorial regions by specifying a positive value of \np{nn\_hdmp}. 
+Equatorward of this latitude the restoration coefficient will be zero with a smooth transition to 
+the full values of a 10$^{\circ}$ latitud band. 
+This is often used because of the short adjustment time scale in the equatorial region 
+\citep{Reverdin1991, Fujio1991, Marti_PhD92}. The time scale associated with the damping depends on the depth as a 
+hyperbolic tangent, with \np{rn\_surf} as surface value, \np{rn\_bot} as bottom value and a transition depth of \np{rn\_dep}.  
 
 % ================================================================
@@ -1167,115 +1124,138 @@
 %        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.
-
-% -------------------------------------------------------------------------------------------------------------
-%        Brunt-Vais\"{a}l\"{a} Frequency
-% -------------------------------------------------------------------------------------------------------------
-\subsection{Brunt-Vais\"{a}l\"{a} Frequency (\np{nn\_eos} = 0, 1 or 2)}
+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}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+
+% -------------------------------------------------------------------------------------------------------------
+%        Brunt-V\"{a}is\"{a}l\"{a} Frequency
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Brunt-V\"{a}is\"{a}l\"{a} Frequency (\np{nn\_eos} = 0, 1 or 2)}
 \label{TRA_bn2}
 
-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): 
+An accurate computation of the ocean stability (i.e. of $N$, the brunt-V\"{a}is\"{a}l\"{a}
+ frequency) is of paramount importance as determine the ocean stratification and 
+ is used in several ocean parameterisations (namely TKE, GLS, Richardson number dependent 
+ vertical diffusion, enhanced vertical diffusion, non-penetrative convection, tidal mixing 
+ parameterisation, iso-neutral diffusion). In particular, $N^2$ has to be computed at the local pressure 
+ (pressure in decibar being approximated by the depth in meters). The expression for $N^2$ 
+ is given by: 
 \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,5 +1278,5 @@
 sea water ($i.e.$ referenced to the surface $p=0$), thus the pressure dependent 
 terms in \eqref{Eq_tra_eos_fzp} (last term) have been dropped. The freezing
-point is computed through \textit{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}.  
 
@@ -1308,11 +1288,13 @@
 \label{TRA_zpshde}
 
-\gmcomment{STEVEN: to be consistent with earlier discussion of differencing and averaging operators, I've changed "derivative" to "difference" and "mean" to "average"}
-
-With partial bottom cells (\np{ln\_zps}=true), in general, tracers in horizontally 
+\gmcomment{STEVEN: to be consistent with earlier discussion of differencing and averaging operators, 
+                   I've changed "derivative" to "difference" and "mean" to "average"}
+
+With partial cells (\np{ln\_zps}=true) at bottom and top (\np{ln\_isfcav}=true), in general, tracers in horizontally 
 adjacent cells live at different depths. Horizontal gradients of tracers are needed 
 for horizontal diffusion (\mdl{traldf} module) and for the hydrostatic pressure 
 gradient (\mdl{dynhpg} module) to be active. 
 \gmcomment{STEVEN from gm : question: not sure of  what -to be active- means}
+
 Before taking horizontal gradients between the tracers next to the bottom, a linear 
 interpolation in the vertical is used to approximate the deeper tracer as if it actually 
@@ -1390,2 +1372,14 @@
 \gmcomment{gm :   this last remark has to be done}
 %%%
+
+If under ice shelf seas opened (\np{ln\_isfcav}=true), the partial cell properties 
+at the top are computed in the same way as for the bottom. Some extra variables are, 
+however, computed to reduce the flow generated at the top and bottom if $z*$ coordinates activated.
+The extra variables calculated and used by \S\ref{DYN_hpg_isf} are:
+
+$\bullet$ $\overline{T}_k^{\,i+1/2}$ as described in \eqref{Eq_zps_hde}
+
+$\bullet$ $\delta _{i+1/2} Z_{T_k} = \widetilde {Z}^{\,i}_{T_k}-Z^{\,i}_{T_k}$ to compute 
+the pressure gradient correction term used by \eqref{Eq_dynhpg_sco} in \S\ref{DYN_hpg_isf},
+ with $\widetilde {Z}_{T_k}$ the depth of the point $\widetilde {T}_{k}$ in case of $z^*$ coordinates 
+(this term = 0 in z-coordinates)
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_ZDF.tex
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_ZDF.tex	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Chap_ZDF.tex	(revision 6440)
@@ -33,10 +33,9 @@
 points, respectively (see \S\ref{TRA_zdf} and \S\ref{DYN_zdf}). These 
 coefficients can be assumed to be either constant, or a function of the local 
-Richardson number, or computed from a turbulent closure model (either 
-TKE or KPP formulation). The computation of these coefficients is initialized 
-in the \mdl{zdfini} module and performed in the \mdl{zdfric}, \mdl{zdftke} or 
-\mdl{zdfkpp} modules. The trends due to the vertical momentum and tracer 
-diffusion, including the surface forcing, are computed and added to the 
-general trend in the \mdl{dynzdf} and \mdl{trazdf} modules, respectively. 
+Richardson number, or computed from a turbulent closure model (TKE, GLS or KPP formulation). 
+The computation of these coefficients is initialized in the \mdl{zdfini} module 
+and performed in the \mdl{zdfric}, \mdl{zdftke}, \mdl{zdfgls} or \mdl{zdfkpp} modules. 
+The trends due to the vertical momentum and tracer diffusion, including the surface forcing, 
+are computed and added to the general trend in the \mdl{dynzdf} and \mdl{trazdf} modules, respectively. 
 These trends can be computed using either a forward time stepping scheme 
 (namelist parameter \np{ln\_zdfexp}=true) or a backward time stepping 
@@ -262,9 +261,9 @@
 \end{equation}
 
-At the ocean surface, a non zero length scale is set through the  \np{rn\_lmin0} namelist 
+At the ocean surface, a non zero length scale is set through the  \np{rn\_mxl0} namelist 
 parameter. Usually the surface scale is given by $l_o = \kappa \,z_o$ 
 where $\kappa = 0.4$ is von Karman's constant and $z_o$ the roughness 
 parameter of the surface. Assuming $z_o=0.1$~m \citep{Craig_Banner_JPO94} 
-leads to a 0.04~m, the default value of \np{rn\_lsurf}. In the ocean interior 
+leads to a 0.04~m, the default value of \np{rn\_mxl0}. In the ocean interior 
 a minimum length scale is set to recover the molecular viscosity when $\bar{e}$ 
 reach its minimum value ($1.10^{-6}= C_k\, l_{min} \,\sqrt{\bar{e}_{min}}$ ).
@@ -295,6 +294,6 @@
 As the surface boundary condition on TKE is prescribed through $\bar{e}_o = e_{bb} |\tau| / \rho_o$, 
 with $e_{bb}$ the \np{rn\_ebb} namelist parameter, setting \np{rn\_ebb}~=~67.83 corresponds 
-to $\alpha_{CB} = 100$. further setting  \np{ln\_lsurf} to true applies \eqref{ZDF_Lsbc} 
-as surface boundary condition on length scale, with $\beta$ hard coded to the Stacet's value.
+to $\alpha_{CB} = 100$. Further setting  \np{ln\_mxl0} to true applies \eqref{ZDF_Lsbc} 
+as surface boundary condition on length scale, with $\beta$ hard coded to the Stacey's value.
 Note that a minimal threshold of \np{rn\_emin0}$=10^{-4}~m^2.s^{-2}$ (namelist parameters) 
 is applied on surface $\bar{e}$ value.
@@ -355,9 +354,46 @@
 %--------------------------------------------------------------%
 
-To be add here a description of "penetration of TKE" and the associated namelist parameters
- \np{nn\_etau}, \np{rn\_efr} and \np{nn\_htau}.
+Vertical mixing parameterizations commonly used in ocean general circulation models 
+tend to produce mixed-layer depths that are too shallow during summer months and windy conditions.
+This bias is particularly acute over the Southern Ocean. 
+To overcome this systematic bias, an ad hoc parameterization is introduced into the TKE scheme  \cite{Rodgers_2014}. 
+The parameterization is an empirical one, $i.e.$ not derived from theoretical considerations, 
+but rather is meant to account for observed processes that affect the density structure of 
+the ocean’s planetary boundary layer that are not explicitly captured by default in the TKE scheme 
+($i.e.$ near-inertial oscillations and ocean swells and waves).
+
+When using this parameterization ($i.e.$ when \np{nn\_etau}~=~1), the TKE input to the ocean ($S$) 
+imposed by the winds in the form of near-inertial oscillations, swell and waves is parameterized 
+by \eqref{ZDF_Esbc} the standard TKE surface boundary condition, plus a depth depend one given by:
+\begin{equation}  \label{ZDF_Ehtau}
+S = (1-f_i) \; f_r \; e_s \; e^{-z / h_\tau} 
+\end{equation}
+where 
+$z$ is the depth,  
+$e_s$ is TKE surface boundary condition, 
+$f_r$ is the fraction of the surface TKE that penetrate in the ocean, 
+$h_\tau$ is a vertical mixing length scale that controls exponential shape of the penetration, 
+and $f_i$ is the ice concentration (no penetration if $f_i=1$, that is if the ocean is entirely 
+covered by sea-ice).
+The value of $f_r$, usually a few percents, is specified through \np{rn\_efr} namelist parameter. 
+The vertical mixing length scale, $h_\tau$, can be set as a 10~m uniform value (\np{nn\_etau}~=~0) 
+or a latitude dependent value (varying from 0.5~m at the Equator to a maximum value of 30~m 
+at high latitudes (\np{nn\_etau}~=~1). 
+
+Note that two other option existe, \np{nn\_etau}~=~2, or 3. They correspond to applying 
+\eqref{ZDF_Ehtau} only at the base of the mixed layer, or to using the high frequency part 
+of the stress to evaluate the fraction of TKE that penetrate the ocean. 
+Those two options are obsolescent features introduced for test purposes.
+They will be removed in the next release. 
+
+
 
 % from Burchard et al OM 2008 : 
-% the most critical process not reproduced by statistical turbulence models is the activity of internal waves and their interaction with turbulence. After the Reynolds decomposition, internal waves are in principle included in the RANS equations, but later partially excluded by the hydrostatic assumption and the model resolution. Thus far, the representation of internal wave mixing in ocean models has been relatively crude (e.g. Mellor, 1989; Large et al., 1994; Meier, 2001; Axell, 2002; St. Laurent and Garrett, 2002).
+% the most critical process not reproduced by statistical turbulence models is the activity of 
+% internal waves and their interaction with turbulence. After the Reynolds decomposition, 
+% internal waves are in principle included in the RANS equations, but later partially 
+% excluded by the hydrostatic assumption and the model resolution. 
+% Thus far, the representation of internal wave mixing in ocean models has been relatively crude 
+% (e.g. Mellor, 1989; Large et al., 1994; Meier, 2001; Axell, 2002; St. Laurent and Garrett, 2002).
 
 
@@ -586,5 +622,6 @@
 Options are defined through the  \ngn{namzdf\_kpp} namelist variables.
 
-\colorbox{yellow}{Add a description of KPP here.}
+Note that KPP is an obsolescent feature of the \NEMO system. 
+It will be removed in the next release (v3.7 and followings).
 
 
@@ -636,5 +673,5 @@
 
 Options are defined through the  \ngn{namzdf} namelist variables.
-The non-penetrative convective adjustment is used when \np{ln\_zdfnpc}=true. 
+The non-penetrative convective adjustment is used when \np{ln\_zdfnpc}~=~\textit{true}. 
 It is applied at each \np{nn\_npc} time step and mixes downwards instantaneously 
 the statically unstable portion of the water column, but only until the density 
@@ -644,5 +681,5 @@
 (Fig. \ref{Fig_npc}): starting from the top of the ocean, the first instability is 
 found. Assume in the following that the instability is located between levels 
-$k$ and $k+1$. The potential temperature and salinity in the two levels are 
+$k$ and $k+1$. The temperature and salinity in the two levels are 
 vertically mixed, conserving the heat and salt contents of the water column. 
 The new density is then computed by a linear approximation. If the new 
@@ -664,24 +701,14 @@
 \citep{Madec_al_JPO91, Madec_al_DAO91, Madec_Crepon_Bk91}.
 
-Note that in the current implementation of this algorithm presents several 
-limitations. First, potential density referenced to the sea surface is used to 
-check whether the density profile is stable or not. This is a strong 
-simplification which leads to large errors for realistic ocean simulations. 
-Indeed, many water masses of the world ocean, especially Antarctic Bottom
-Water, are unstable when represented in surface-referenced potential density. 
-The scheme will erroneously mix them up. Second, the mixing of potential 
-density is assumed to be linear. This assures the convergence of the algorithm 
-even when the equation of state is non-linear. Small static instabilities can thus 
-persist due to cabbeling: they will be treated at the next time step. 
-Third, temperature and salinity, and thus density, are mixed, but the 
-corresponding velocity fields remain unchanged. When using a Richardson 
-Number dependent eddy viscosity, the mixing of momentum is done through 
-the vertical diffusion: after a static adjustment, the Richardson Number is zero 
-and thus the eddy viscosity coefficient is at a maximum. When this convective 
-adjustment algorithm is used with constant vertical eddy viscosity, spurious 
-solutions can occur since the vertical momentum diffusion remains small even 
-after a static adjustment. In that case, we recommend the addition of momentum 
-mixing in a manner that mimics the mixing in temperature and salinity 
-\citep{Speich_PhD92, Speich_al_JPO96}.
+The current implementation has been modified in order to deal with any non linear 
+equation of seawater (L. Brodeau, personnal communication). 
+Two main differences have been introduced compared to the original algorithm: 
+$(i)$ the stability is now checked using the Brunt-V\"{a}is\"{a}l\"{a} frequency 
+(not the the difference in potential density) ; 
+$(ii)$ when two levels are found unstable, their thermal and haline expansion coefficients 
+are vertically mixed in the same way their temperature and salinity has been mixed.
+These two modifications allow the algorithm to perform properly and accurately 
+with TEOS10 or EOS-80 without having to recompute the expansion coefficients at each 
+mixing iteration.
 
 % -------------------------------------------------------------------------------------------------------------
@@ -689,5 +716,5 @@
 % -------------------------------------------------------------------------------------------------------------
 \subsection   [Enhanced Vertical Diffusion (\np{ln\_zdfevd})]
-			{Enhanced Vertical Diffusion (\np{ln\_zdfevd}=true)}
+		     	  {Enhanced Vertical Diffusion (\np{ln\_zdfevd}=true)}
 \label{ZDF_evd}
 
@@ -830,5 +857,5 @@
 % Bottom Friction
 % ================================================================
-\section  [Bottom and top Friction (\textit{zdfbfr})]   {Bottom Friction (\mdl{zdfbfr} module)}
+\section  [Bottom and Top Friction (\textit{zdfbfr})]   {Bottom and Top Friction (\mdl{zdfbfr} module)}
 \label{ZDF_bfr}
 
@@ -838,6 +865,8 @@
 
 Options to define the top and bottom friction are defined through the  \ngn{nambfr} namelist variables.
-The top friction is activated only if the ice shelf cavities are opened (\np{ln\_isfcav}~=~true).
-As the friction processes at the top and bottom are the represented similarly, only the bottom friction is described in detail.
+The bottom friction represents the friction generated by the bathymetry. 
+The top friction represents the friction generated by the ice shelf/ocean interface. 
+As the friction processes at the top and bottom are represented similarly, only the bottom friction is described in detail below.\\
+
 
 Both the surface momentum flux (wind stress) and the bottom momentum 
@@ -912,5 +941,5 @@
 $H = 4000$~m, the resulting friction coefficient is $r = 4\;10^{-4}$~m\;s$^{-1}$. 
 This is the default value used in \NEMO. It corresponds to a decay time scale 
-of 115~days. It can be changed by specifying \np{rn\_bfric1} (namelist parameter).
+of 115~days. It can be changed by specifying \np{rn\_bfri1} (namelist parameter).
 
 For the linear friction case the coefficients defined in the general 
@@ -922,5 +951,5 @@
 \end{split}
 \end{equation}
-When \np{nn\_botfr}=1, the value of $r$ used is \np{rn\_bfric1}. 
+When \np{nn\_botfr}=1, the value of $r$ used is \np{rn\_bfri1}. 
 Setting \np{nn\_botfr}=0 is equivalent to setting $r=0$ and leads to a free-slip 
 bottom boundary condition. These values are assigned in \mdl{zdfbfr}. 
@@ -929,5 +958,5 @@
 in the \ifile{bfr\_coef} input NetCDF file. The mask values should vary from 0 to 1. 
 Locations with a non-zero mask value will have the friction coefficient increased 
-by $mask\_value$*\np{rn\_bfrien}*\np{rn\_bfric1}.
+by $mask\_value$*\np{rn\_bfrien}*\np{rn\_bfri1}.
 
 % -------------------------------------------------------------------------------------------------------------
@@ -949,5 +978,5 @@
 $e_b = 2.5\;10^{-3}$m$^2$\;s$^{-2}$, while the FRAM experiment \citep{Killworth1992} 
 uses $C_D = 1.4\;10^{-3}$ and $e_b =2.5\;\;10^{-3}$m$^2$\;s$^{-2}$. 
-The CME choices have been set as default values (\np{rn\_bfric2} and \np{rn\_bfeb2} 
+The CME choices have been set as default values (\np{rn\_bfri2} and \np{rn\_bfeb2} 
 namelist parameters).
 
@@ -964,10 +993,41 @@
 \end{equation}
 
-The coefficients that control the strength of the non-linear bottom friction are 
-initialised as namelist parameters: $C_D$= \np{rn\_bfri2}, and $e_b$ =\np{rn\_bfeb2}. 
-Note for applications which treat tides explicitly a low or even zero value of 
-\np{rn\_bfeb2} is recommended. From v3.2 onwards a local enhancement of $C_D$ 
-is possible via an externally defined 2D mask array (\np{ln\_bfr2d}=true). 
-See previous section for details.
+The coefficients that control the strength of the non-linear bottom friction are
+initialised as namelist parameters: $C_D$= \np{rn\_bfri2}, and $e_b$ =\np{rn\_bfeb2}.
+Note for applications which treat tides explicitly a low or even zero value of
+\np{rn\_bfeb2} is recommended. From v3.2 onwards a local enhancement of $C_D$ is possible
+via an externally defined 2D mask array (\np{ln\_bfr2d}=true).  This works in the same way
+as for the linear bottom friction case with non-zero masked locations increased by
+$mask\_value$*\np{rn\_bfrien}*\np{rn\_bfri2}.
+
+% -------------------------------------------------------------------------------------------------------------
+%       Bottom Friction Log-layer
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Log-layer Bottom Friction enhancement (\np{nn\_botfr} = 2, \np{ln\_loglayer} = .true.)}
+\label{ZDF_bfr_loglayer}
+
+In the non-linear bottom friction case, the drag coefficient, $C_D$, can be optionally
+enhanced using a "law of the wall" scaling. If  \np{ln\_loglayer} = .true., $C_D$ is no
+longer constant but is related to the thickness of the last wet layer in each column by:
+
+\begin{equation}
+C_D = \left ( {\kappa \over {\rm log}\left ( 0.5e_{3t}/rn\_bfrz0 \right ) } \right )^2
+\end{equation}
+
+\noindent where $\kappa$ is the von-Karman constant and \np{rn\_bfrz0} is a roughness
+length provided via the namelist.
+
+For stability, the drag coefficient is bounded such that it is kept greater or equal to
+the base \np{rn\_bfri2} value and it is not allowed to exceed the value of an additional
+namelist parameter: \np{rn\_bfri2\_max}, i.e.:
+
+\begin{equation}
+rn\_bfri2 \leq C_D \leq rn\_bfri2\_max
+\end{equation}
+
+\noindent Note also that a log-layer enhancement can also be applied to the top boundary
+friction if under ice-shelf cavities are in use (\np{ln\_isfcav}=.true.).  In this case, the
+relevant namelist parameters are \np{rn\_tfrz0}, \np{rn\_tfri2}
+and \np{rn\_tfri2\_max}.
 
 % -------------------------------------------------------------------------------------------------------------
@@ -1253,2 +1313,58 @@
 
 % ================================================================
+% Internal wave-driven mixing
+% ================================================================
+\section{Internal wave-driven mixing (\key{zdftmx\_new})}
+\label{ZDF_tmx_new}
+
+%--------------------------------------------namzdf_tmx_new------------------------------------------
+\namdisplay{namzdf_tmx_new}
+%--------------------------------------------------------------------------------------------------------------
+
+The parameterization of mixing induced by breaking internal waves is a generalization 
+of the approach originally proposed by \citet{St_Laurent_al_GRL02}. 
+A three-dimensional field of internal wave energy dissipation $\epsilon(x,y,z)$ is first constructed, 
+and the resulting diffusivity is obtained as 
+\begin{equation} \label{Eq_Kwave}
+A^{vT}_{wave} =  R_f \,\frac{ \epsilon }{ \rho \, N^2 }
+\end{equation}
+where $R_f$ is the mixing efficiency and $\epsilon$ is a specified three dimensional distribution 
+of the energy available for mixing. If the \np{ln\_mevar} namelist parameter is set to false, 
+the mixing efficiency is taken as constant and equal to 1/6 \citep{Osborn_JPO80}. 
+In the opposite (recommended) case, $R_f$ is instead a function of the turbulence intensity parameter 
+$Re_b = \frac{ \epsilon}{\nu \, N^2}$, with $\nu$ the molecular viscosity of seawater, 
+following the model of \cite{Bouffard_Boegman_DAO2013} 
+and the implementation of \cite{de_lavergne_JPO2016_efficiency}.
+Note that $A^{vT}_{wave}$ is bounded by $10^{-2}\,m^2/s$, a limit that is often reached when the mixing efficiency is constant.
+
+In addition to the mixing efficiency, the ratio of salt to heat diffusivities can chosen to vary 
+as a function of $Re_b$ by setting the \np{ln\_tsdiff} parameter to true, a recommended choice). 
+This parameterization of differential mixing, due to \cite{Jackson_Rehmann_JPO2014}, 
+is implemented as in \cite{de_lavergne_JPO2016_efficiency}.
+
+The three-dimensional distribution of the energy available for mixing, $\epsilon(i,j,k)$, is constructed 
+from three static maps of column-integrated internal wave energy dissipation, $E_{cri}(i,j)$, 
+$E_{pyc}(i,j)$, and $E_{bot}(i,j)$, combined to three corresponding vertical structures 
+(de Lavergne et al., in prep):
+\begin{align*}
+F_{cri}(i,j,k) &\propto e^{-h_{ab} / h_{cri} }\\
+F_{pyc}(i,j,k) &\propto N^{n\_p}\\
+F_{bot}(i,j,k) &\propto N^2 \, e^{- h_{wkb} / h_{bot} }
+\end{align*} 
+In the above formula, $h_{ab}$ denotes the height above bottom, 
+$h_{wkb}$ denotes the WKB-stretched height above bottom, defined by
+\begin{equation*}
+h_{wkb} = H \, \frac{ \int_{-H}^{z} N \, dz' } { \int_{-H}^{\eta} N \, dz'  } \; ,
+\end{equation*}
+The $n_p$ parameter (given by \np{nn\_zpyc} in \ngn{namzdf\_tmx\_new} namelist)  controls the stratification-dependence of the pycnocline-intensified dissipation. 
+It can take values of 1 (recommended) or 2.
+Finally, the vertical structures $F_{cri}$ and $F_{bot}$ require the specification of 
+the decay scales $h_{cri}(i,j)$ and $h_{bot}(i,j)$, which are defined by two additional input maps. 
+$h_{cri}$ is related to the large-scale topography of the ocean (etopo2) 
+and $h_{bot}$ is a function of the energy flux $E_{bot}$, the characteristic horizontal scale of 
+the abyssal hill topography \citep{Goff_JGR2010} and the latitude.
+
+% ================================================================
+
+
+
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Introduction.tex
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Introduction.tex	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Chapters/Introduction.tex	(revision 6440)
@@ -24,11 +24,10 @@
 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  
@@ -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}.
@@ -227,5 +228,5 @@
 \item a deep re-writting and simplification of the off-line tracer component (OFF\_SRC) ; 
 \item the merge of passive and active advection and diffusion modules ;
-\item  Use of the Flexible Configuration Manager (FCM) to build configurations, generate the Makefile and produce the executable ;
+\item Use of the Flexible Configuration Manager (FCM) to build configurations, generate the Makefile and produce the executable ;
 \item Linear-tangent and Adjoint component (TAM) added, phased with v3.0
 \end{enumerate}
@@ -249,2 +250,42 @@
 
 
+ \vspace{1cm}
+$\bullet$ The main modifications from NEMO/OPA v3.4 and  v3.6 are :\\
+\begin{enumerate}
+\item I/O management: NEMO in now interfaced with XIOS, a Input/Output server having a versatile xml user interface, and 
+allowing I/O to be performed on dedicated processors thus improving scalability and performance on massively parallel platforms. 
+\item ICB module \citep{Marsh_GMD2015}: icebergs as lagrangian floats ; 
+\item SAS: Stand Alone Surface module allowing testing of forcing set with bulk formulae, to run sea-ice models without ocean, to run ICB icebergs module alone, and to test AGRIF with sea-ice
+\item ISF : Under ice-selves cavities (parametrisation and/or explicit representation)
+\item Coupled interface for next IPCC requirements (multi category sea-ice, calving and iceberg module)
+\item Ocean and ice allowed to be explicitly coupled through OASIS, using StandAlone Surface module)
+\item On line coarsening of ocean I/O
+\item Major evolution of LIM3 sea-ice model \citep{Rousset_GMD2015}
+\item Open boundaries: completion of BDY/OBC merge : BDY is now the only Open boundary module available
+\item re-visit of the specification of heat/salt(tracers)/mass fluxes ;
+\item levitating or fully embedded sea-ice (for LIM and CICE) ;
+\item a new parameterization of mixing induced by breaking internal waves (de Lavergne et al. in prep.)
+And also:
+\item update of AGRIF package and AGRIF compatibility with LIM2 sea-ice model ;
+\item A new vertical sigma coordinate stretching function \citep{Siddorn_Furner_OM12} ;
+\item Smagorinsky eddy coefficients: the \cite{Griffies_Hallberg_MWR00} Smagorinsky type diffusivity/viscosity for lateral mixing has been introduced ;
+\item Standard Fox Kemper parametrisation
+\item Analytical tropical cyclones taken in account using track and magnitude observations (Vincent et al. JGR 2012a,b) ;
+\item OBS: observation operators improved and now available in Standalone mode ;
+\item Log layer option for bottom friction
+\item Faster split-explicit time stepping ; 
+\item Z-tilde ALE coordinates \citep{Leclair_Madec_OM11} ; 
+\item implicit bottom friction ;
+\item Runoff improved and SBC with BGC
+\item MPP assessment and optimisation
+\item First steps of wave coupling
+
+Features becoming obsolete: LIM2 (replaced by LIM3 monocategory) ; IOIPSL (replaced by XIOS) ; 
+
+Features that has been removed : LOBSTER (now included in PISCES) ; OBC, replaced by BDY ;   
+
+
+
+\end{enumerate}
+
+
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/nam_asminc
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/nam_asminc	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/nam_asminc	(revision 6440)
@@ -0,0 +1,18 @@
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+    ln_bkgwri = .false.    !  Logical switch for writing out background state
+    ln_trainc = .false.    !  Logical switch for applying tracer increments
+    ln_dyninc = .false.    !  Logical switch for applying velocity increments
+    ln_sshinc = .false.    !  Logical switch for applying SSH increments
+    ln_asmdin = .false.    !  Logical switch for Direct Initialization (DI)
+    ln_asmiau = .false.    !  Logical switch for Incremental Analysis Updating (IAU)
+    nitbkg    = 0          !  Timestep of background in [0,nitend-nit000-1]
+    nitdin    = 0          !  Timestep of background for DI in [0,nitend-nit000-1]
+    nitiaustr = 1          !  Timestep of start of IAU interval in [0,nitend-nit000-1]
+    nitiaufin = 15         !  Timestep of end of IAU interval in [0,nitend-nit000-1]
+    niaufn    = 0          !  Type of IAU weighting function
+    ln_salfix = .false.    !  Logical switch for ensuring that the sa > salfixmin
+    salfixmin = -9999      !  Minimum salinity after applying the increments
+    nn_divdmp = 0          !  Number of iterations of divergence damping operator
+/
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/nam_diaharm
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/nam_diaharm	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/nam_diaharm	(revision 6440)
@@ -0,0 +1,9 @@
+!-----------------------------------------------------------------------
+&nam_diaharm   !   Harmonic analysis of tidal constituents ('key_diaharm')
+!-----------------------------------------------------------------------
+    nit000_han = 1         ! First time step used for harmonic analysis
+    nitend_han = 75        ! Last time step used for harmonic analysis
+    nstep_han  = 15        ! Time step frequency for harmonic analysis
+    tname(1)   = 'M2'      ! Name of tidal constituents
+    tname(2)   = 'K1'
+/
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/nam_tide
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/nam_tide	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/nam_tide	(revision 6440)
@@ -3,14 +3,6 @@
 !-----------------------------------------------------------------------
    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/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/nam_vvl
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/nam_vvl	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/nam_vvl	(revision 6440)
@@ -0,0 +1,14 @@
+!-----------------------------------------------------------------------
+&nam_vvl    !   vertical coordinate options
+!-----------------------------------------------------------------------
+   ln_vvl_zstar  = .true.           !  zstar vertical coordinate
+   ln_vvl_ztilde = .false.          !  ztilde vertical coordinate: only high frequency variations
+   ln_vvl_layer  = .false.          !  full layer vertical coordinate
+   ln_vvl_ztilde_as_zstar = .false. !  ztilde vertical coordinate emulating zstar
+   ln_vvl_zstar_at_eqtor = .false.  !  ztilde near the equator
+   rn_ahe3       = 0.0e0            !  thickness diffusion coefficient
+   rn_rst_e3t    = 30.e0            !  ztilde to zstar restoration timescale [days]
+   rn_lf_cutoff  = 5.0e0            !  cutoff frequency for low-pass filter  [days]
+   rn_zdef_max   = 0.9e0            !  maximum fractional e3t deformation
+   ln_vvl_dbg    = .true.           !  debug prints    (T/F)
+/
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namasm
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namasm	(revision 6439)
+++ 	(revision )
@@ -1,18 +1,0 @@
-!-----------------------------------------------------------------------
-&nam_asminc   !   assimilation increments                               ('key_asminc')
-!-----------------------------------------------------------------------
-    ln_bkgwri = .false.    !  Logical switch for writing out background state
-    ln_trainc = .false.    !  Logical switch for applying tracer increments
-    ln_dyninc = .false.    !  Logical switch for applying velocity increments
-    ln_sshinc = .false.    !  Logical switch for applying SSH increments
-    ln_asmdin = .false.    !  Logical switch for Direct Initialization (DI)
-    ln_asmiau = .false.    !  Logical switch for Incremental Analysis Updating (IAU)
-    nitbkg    = 0          !  Timestep of background in [0,nitend-nit000-1]
-    nitdin    = 0          !  Timestep of background for DI in [0,nitend-nit000-1]
-    nitiaustr = 1          !  Timestep of start of IAU interval in [0,nitend-nit000-1]
-    nitiaufin = 15         !  Timestep of end of IAU interval in [0,nitend-nit000-1]
-    niaufn    = 0          !  Type of IAU weighting function
-    ln_salfix = .false.    !  Logical switch for ensuring that the sa > salfixmin
-    salfixmin = -9999      !  Minimum salinity after applying the increments
-    nn_divdmp = 0          !  Number of iterations of divergence damping operator
-/
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/nambbc
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/nambbc	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/nambbc	(revision 6440)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition
+!-----------------------------------------------------------------------
+!              !                              !  (if <0  months)  !  
+!              !  file name      ! frequency (hours) ! variable   ! time interp.   !  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !                 !  (if <0  months)  !   name     !   (logical)    !  (T/F ) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_qgh      ='geothermal_heating.nc',  -12.  , 'heatflow'      ,   .false.      , .true.  , 'yearly'  , ''       , ''       , ''
+   !
+   cn_dir      = './'      !  root directory for the location of the runoff files
+   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom
+   nn_geoflx   =    2      !  geothermal heat flux: = 0 no flux
+                           !     = 1 constant flux
+                           !     = 2 variable flux (read in geothermal_heating.nc in mW/m2)
+   rn_geoflx_cst = 86.4e-3 !  Constant value of geothermal heat flux [W/m2]
+
+/
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/nambdy
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/nambdy	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/nambdy	(revision 6440)
@@ -2,22 +2,34 @@
 &nambdy        !  unstructured open boundaries                          ("key_bdy")
 !-----------------------------------------------------------------------
-    nb_bdy = 1                            !  number of open boundary sets
-    ln_coords_file = .true.               !  =T : read bdy coordinates from file
-    cn_coords_file = 'coordinates.bdy.nc' !  bdy coordinates files
-    ln_mask_file = .false.                !  =T : read mask from file
-    cn_mask_file = ''                     !  name of mask file (if ln_mask_file=.TRUE.)
-    nn_dyn2d      =  2                    !  boundary conditions for barotropic fields
-    nn_dyn2d_dta  =  3                    !  = 0, bdy data are equal to the initial state
-                                          !  = 1, bdy data are read in 'bdydata   .nc' files
-                                          !  = 2, use tidal harmonic forcing data from files
-                                          !  = 3, use external data AND tidal harmonic forcing
-    nn_dyn3d      =  0                    !  boundary conditions for baroclinic velocities
-    nn_dyn3d_dta  =  0                    !  = 0, bdy data are equal to the initial state
-                           !  = 1, bdy data are read in 'bdydata   .nc' files
-    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
+    nb_bdy = 2                               !  number of open boundary sets       
+    ln_coords_file = .true.,.false.          !  =T : read bdy coordinates from file
+    cn_coords_file = 'coordinates.bdy.nc','' !  bdy coordinates files
+    ln_mask_file = .false.                   !  =T : read mask from file
+    cn_mask_file = ''                        !  name of mask file (if ln_mask_file=.TRUE.)
+    cn_dyn2d       = 'none','none'           !
+    nn_dyn2d      =  2, 0                    !  boundary conditions for barotropic fields
+    nn_dyn2d_dta  =  3, 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
+    cn_dyn3d      =  'none',' none'          !
+    nn_dyn3d      =  0, 0                    !  boundary conditions for baroclinic velocities
+    nn_dyn3d_dta  =  0, 0                    !  = 0, bdy data are equal to the initial state
+                                             !  = 1, bdy data are read in 'bdydata   .nc' files
+    cn_tra        =  'none', 'none'          !
+    nn_tra_dta    =  1, 1                    !  = 0, bdy data are equal to the initial state
+                                             !  = 1, bdy data are read in 'bdydata   .nc' files
+    cn_ice_lim      =  'none','none'         !
+    nn_ice_lim_dta  =  0, 0                  !  = 0, bdy data are equal to the initial state
+                                             !  = 1, bdy data are read in 'bdydata   .nc' files
+    rn_ice_tem      = 270., 270.             !  lim3 only: arbitrary temperature of incoming sea ice
+    rn_ice_sal      = 10.,  10.              !  lim3 only:      --   salinity           --
+    rn_ice_age      = 30., 30.               !  lim3 only:      --   age                --
+    ln_tra_dmp    = .false.,.false.          !  open boudaries conditions for tracers
+    ln_dyn3d_dmp  = .false.,.false.          !  open boundary condition for baroclinic velocities
+    rn_time_dmp   =  1., 1.                  ! Damping time scale in days
+    rn_time_dmp_out =  1., 1.                ! Outflow damping time scale
+    nn_rimwidth  = 10, 5                     !  width of the relaxation zone
+    ln_vol     = .false.                     !  total volume correction (see nn_volctl parameter)
+    nn_volctl  = 1                           !  = 0, the total water flux across open boundaries is zero
 /
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/nambdy_dta
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/nambdy_dta	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/nambdy_dta	(revision 6440)
@@ -2,13 +2,21 @@
 &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'  ,    ''    ,   ''    , ''
+!              !  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/'
    ln_full_vel = .false.
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namberg
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namberg	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namberg	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namc1d
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namc1d	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namc1d	(revision 6440)
@@ -0,0 +1,7 @@
+!-----------------------------------------------------------------------
+&namc1d        !   1D configuration options                             ("key_c1d")
+!-----------------------------------------------------------------------
+   rn_lat1d    =      50   !  Column latitude (default at PAPA station)
+   rn_lon1d    =    -145   !  Column longitude (default at PAPA station)
+   ln_c1d_locpt=  .true.   ! Localization of 1D config in a grid (T) or independant point (F)
+/
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namc1d_dyndmp
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namc1d_dyndmp	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namc1d_dyndmp	(revision 6440)
@@ -0,0 +1,5 @@
+!-----------------------------------------------------------------------
+&namc1d_dyndmp !   U & V newtonian damping                              ("key_c1d")
+!-----------------------------------------------------------------------
+   ln_dyndmp   =  .false.  !  add a damping term (T) or not (F)
+/
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namc1d_uvd
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namc1d_uvd	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namc1d_uvd	(revision 6440)
@@ -0,0 +1,12 @@
+!-----------------------------------------------------------------------
+&namc1d_uvd    !   data: U & V currents                                 ("key_c1d")
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_ucur     = 'ucurrent'  ,         -1        ,'u_current',   .false.    , .true. , 'monthly' ,  ''      ,  'Ume'   , ''
+   sn_vcur     = 'vcurrent'  ,         -1        ,'v_current',   .false.    , .true. , 'monthly' ,  ''      ,  'Vme'   , ''
+!
+   cn_dir        = './'    !  root directory for the location of the files
+   ln_uvd_init   = .false. !  Initialisation of ocean U & V with U & V input data (T) or not (F)
+   ln_uvd_dyndmp = .false. !  damping of ocean U & V toward U & V input data (T) or not (F)
+/
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namcfg
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namcfg	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namcfg	(revision 6440)
@@ -0,0 +1,22 @@
+!-----------------------------------------------------------------------
+&namcfg     !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "default"            !  name of the configuration
+   cp_cfz      =  "no zoom"            !  name of the zoom of configuration
+   jp_cfg      =       0               !  resolution of the configuration
+   jpidta      =      10               !  1st lateral dimension ( >= jpi )
+   jpjdta      =      12               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      31               !  number of levels      ( >= jpk )
+   jpiglo      =      10               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =      12               !  2nd    -                  -    --> j =jpjdta
+   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1               !  in data domain indices
+   jperio      =       0               !  lateral cond. type (between 0 and 6)
+                                       !  = 0 closed                 ;   = 1 cyclic East-West
+                                       !  = 2 equatorial symmetric   ;   = 3 North fold T-point pivot
+                                       !  = 4 cyclic East-West AND North fold T-point pivot
+                                       !  = 5 North fold F-point pivot
+                                       !  = 6 cyclic East-West AND North fold F-point pivot
+   ln_use_jattr = .false.              !  use (T) the file attribute: open_ocean_jstart, if present
+                                       !  in netcdf input files, as the start j-row for reading
+/
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namcfg_orca1
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namcfg_orca1	(revision 6439)
+++ 	(revision )
@@ -1,12 +1,0 @@
-!-----------------------------------------------------------------------
-&namcfg        !   parameters of the configuration
-!-----------------------------------------------------------------------
-   cp_cfg      =  "orca"               !  name of the configuration
-   jp_cfg      =       1               !  resolution of the configuration
-   jpidta      =     362               !  1st lateral dimension ( >= jpi )
-   jpjdta      =     292               !  2nd    "         "    ( >= jpj )
-   jpkdta      =      75               !  number of levels      ( >= jpk )
-   jpiglo      =     362               !  1st dimension of global domain --> i =jpidta
-   jpjglo      =     292               !  2nd    -                  -    --> j  =jpjdta
-   jperio      =       6               !  lateral cond. type (between 0 and 6)
-   ln_use_jattr = .true.               !  use (T) the file attribute: open_ocean_jstart if present
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namcrs
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namcrs	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namcrs	(revision 6440)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+               !   passive tracer coarsened online simulations
+!-----------------------------------------------------------------------
+   nn_factx    = 3         !  Reduction factor of x-direction
+   nn_facty    = 3         !  Reduction factor of y-direction
+   nn_binref   = 0         !  Bin centering preference: NORTH or EQUAT
+                           !  0, coarse grid is binned with preferential treatment of the north fold
+                           !  1, coarse grid is binned with centering at the equator
+                           !    Symmetry with nn_facty being odd-numbered. Asymmetry with even-numbered nn_facty.
+   nn_msh_crs  = 1         !  create (=1) a mesh file or not (=0)
+   nn_crs_kz   = 0         ! 0, MEAN of volume boxes
+                           ! 1, MAX of boxes
+                           ! 2, MIN of boxes
+   ln_crs_wn   = .true.    ! wn coarsened (T) or computed using horizontal divergence ( F )
+/
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namdia_harm
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namdia_harm	(revision 6439)
+++ 	(revision )
@@ -1,9 +1,0 @@
-!-----------------------------------------------------------------------
-&nam_diaharm   !   Harmonic analysis of tidal constituents ('key_diaharm')
-!-----------------------------------------------------------------------
-    nit000_han = 1         ! First time step used for harmonic analysis
-    nitend_han = 75        ! Last time step used for harmonic analysis
-    nstep_han  = 15        ! Time step frequency for harmonic analysis
-    tname(1)   = 'M2'      ! Name of tidal constituents
-    tname(2)   = 'K1'
-/
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namdom
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namdom	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namdom	(revision 6440)
@@ -3,6 +3,7 @@
 !-----------------------------------------------------------------------
    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_e3zps_min=   20.     !  partial step thickness is set larger than the minimum of
@@ -16,4 +17,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/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namdyn_adv
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namdyn_adv	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namdyn_adv	(revision 6440)
@@ -2,6 +2,8 @@
 &namdyn_adv    !   formulation of the momentum advection
 !-----------------------------------------------------------------------
-   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/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namdyn_hpg
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namdyn_hpg	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namdyn_hpg	(revision 6440)
@@ -5,5 +5,5 @@
    ln_hpg_zps  = .true.    !  z-coordinate - partial steps (interpolation)
    ln_hpg_sco  = .false.   !  s-coordinate (standard jacobian formulation)
-   ln_hpg_isf  = .false.   !  s-coordinate (sco ) adapted to 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)
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namdyn_vor
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namdyn_vor	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namdyn_vor	(revision 6440)
@@ -6,3 +6,4 @@
    ln_dynvor_mix = .false. !  mixed scheme
    ln_dynvor_een = .true.  !  energy & enstrophy scheme
+   ln_dynvor_een_old = .false.  !  energy & enstrophy scheme - original formulation
 /
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/nameos
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/nameos	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/nameos	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namhsb
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namhsb	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namhsb	(revision 6440)
@@ -1,4 +1,4 @@
 !-----------------------------------------------------------------------
-&namhsb       !  Heat and salt budgets 
+&namhsb       !  Heat and salt budgets
 !-----------------------------------------------------------------------
    ln_diahsb  = .false.    !  check the heat and salt budgets (T) or not (F)
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/nammpp_dyndist
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/nammpp_dyndist	(revision 6439)
+++ 	(revision )
@@ -1,7 +1,0 @@
-!-----------------------------------------------------------------------
-&nammpp_dyndist !   Massively Parallel Distribution for AGRIF zoom      ("key_agrif" && "key_mpp_dyndist")
-!-----------------------------------------------------------------------
-   jpni        =    1      !  jpni   number of processors following i
-   jpnj        =    1      !  jpnj   number of processors following j
-   jpnij       =    1      !  jpnij  number of local domains
-/
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namobs
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namobs	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namobs	(revision 6440)
@@ -5,58 +5,52 @@
    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_cor     = .false.    ! 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_ssh     = .false.    ! Logical switch for SSH observations
+   ln_sst     = .false.    ! Logical switch for SST observations
+   ln_reysst  = .false.    ! Logical switch for Reynolds observations
+   ln_ghrsst  = .false.    ! Logical switch for GHRSST observations
    ln_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_sss     = .false.    ! Logical switch for SSS observations
+   ln_seaice  = .false.    ! Logical switch for Sea Ice observations
+   ln_vel3d   = .false.    ! Logical switch for velocity observations
+   ln_velavcur= .false     ! Logical switch for velocity daily av. cur.
+   ln_velhrcur= .false     ! Logical switch for velocity high freq. cur.
+   ln_velavadcp = .false.  ! Logical switch for velocity daily av. ADCP
+   ln_velhradcp = .false.  ! Logical switch for velocity high freq. ADCP
+   ln_velfb   = .false.    ! Logical switch for feedback velocity data
+   ln_grid_global = .false. ! Global distribtion of observations
+   ln_grid_search_lookup = .false. !  Logical switch for obs grid search w/lookup table
+   grid_search_file = 'grid_search'  !  Grid search lookup file header
+! All of the *files* variables below are arrays. Use namelist_cfg to add more files
+   enactfiles = 'enact.nc' !  ENACT input observation file names (specify full array in namelist_cfg)
+   coriofiles = 'corio.nc' !  Coriolis input observation file name
+   profbfiles = 'profiles_01.nc' ! Profile feedback input observation file name
+   ln_profb_enatim = .false !        Enact feedback input time setting switch
+   slafilesact = 'sla_act.nc' !  Active SLA input observation file names
+   slafilespas = 'sla_pass.nc' ! Passive SLA input observation file names
+   slafbfiles = 'sla_01.nc' ! slafbfiles: Feedback SLA input observation file names
+   sstfiles = 'ghrsst.nc'   ! GHRSST input observation file names
+   sstfbfiles = 'sst_01.nc' ! Feedback SST input observation file names
+   seaicefiles = 'seaice_01.nc' ! Sea Ice input observation file names
+   velavcurfiles = 'velavcurfile.nc'  ! Vel. cur. daily av. input file name
+   velhrcurfiles = 'velhrcurfile.nc'  ! Vel. cur. high freq. input file name
+   velavadcpfiles = 'velavadcpfile.nc' ! Vel. ADCP daily av. input file name
+   velhradcpfiles = 'velhradcpfile.nc' ! Vel. ADCP high freq. input file name
+   velfbfiles = 'velfbfile.nc' ! Vel. feedback input observation file name
+   dobsini = 20000101.000000  !  Initial date in window YYYYMMDD.HHMMSS
+   dobsend = 20010101.000000  !  Final date in window YYYYMMDD.HHMMSS
+   n1dint = 0  !               Type of vertical interpolation method
+   n2dint = 0  !               Type of horizontal interpolation method
+   ln_nea = .false.   !        Rejection of observations near land switch
+   nmsshc     = 0     !        MSSH correction scheme
+   mdtcorr = 1.61     !        MDT  correction
+   mdtcutoff = 65.0   !        MDT cutoff for computed correction
    ln_altbias = .false.    ! Logical switch for alt bias
    ln_ignmis  = .true.     ! Logical switch for ignoring missing files
-                           !     endailyavtypes   ENACT daily average types
+   endailyavtypes = 820    ! ENACT daily average types - array (use namelist_cfg to set more values)
    ln_grid_global = .true.
    ln_grid_search_lookup = .false.
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namobs_example
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namobs_example	(revision 6439)
+++ 	(revision )
@@ -1,63 +1,0 @@
-!-----------------------------------------------------------------------
-!       namobs    observation usage switch
-!-----------------------------------------------------------------------
-!
-!  ln_t3d                  Logical switch for T profile observations         
-!  ln_s3d                  Logical switch for S profile observations          
-!  ln_ena                  Logical switch for ENACT insitu data set           
-!  ln_cor                  Logical switch for Coriolis insitu data set       
-!  ln_profb                Logical switch for feedback insitu data set     
-!  ln_sla                  Logical switch for SLA observations               
-!  ln_sladt                Logical switch for AVISO SLA data              
-!  ln_slafb                Logical switch for feedback SLA data            
-!  ln_ssh                  Logical switch for SSH observations              
-!  ln_sst                  Logical switch for SST observations              
-!  ln_reysst               Logical switch for Reynolds observations       
-!  ln_ghrsst               Logical switch for GHRSST observations          
-!  ln_sstfb                Logical switch for feedback SST data          
-!  ln_sss                  Logical switch for SSS observations              
-!  ln_seaice               Logical switch for Sea Ice observations        
-!  ln_vel3d                Logical switch for velocity observations         
-!  ln_velavcur             Logical switch for velocity daily av. cur.    
-!  ln_velhrcur             Logical switch for velocity high freq. cur.   
-!  ln_velavadcp            Logical switch for velocity daily av. ADCP  
-!  ln_velhradcp            Logical switch for velocity high freq. ADCP
-!  ln_velfb                Logical switch for feedback velocity data       
-!  ln_grid_global          Global distribtion of observations         
-!  ln_grid_search_lookup   Logical switch for obs grid search w/lookup table  
-!  grid_search_file        Grid search lookup file header 
-!  enactfiles              ENACT input observation file names 
-!  coriofiles              Coriolis input observation file name  
-!  profbfiles              Profile feedback input observation file name 
-!  ln_profb_enatim         Enact feedback input time setting switch    
-!  slafilesact             Active SLA input observation file name
-!  slafilespas             Passive SLA input observation file name 
-!  slafbfiles              Feedback SLA input observation file name 
-!  sstfiles                GHRSST input observation file name       
-!  sstfbfiles              Feedback SST input observation file name 
-!  seaicefiles             Sea Ice input observation file name 
-!  velavcurfiles           Vel. cur. daily av. input file name  
-!  velhvcurfiles           Vel. cur. high freq. input file name  
-!  velavadcpfiles          Vel. ADCP daily av. input file name    
-!  velhvadcpfiles          Vel. ADCP high freq. input file name 
-!  velfbfiles              Vel. feedback input observation file name 
-!  dobsini                 Initial date in window YYYYMMDD.HHMMSS       
-!  dobsend                 Final date in window YYYYMMDD.HHMMSS         
-!  n1dint                  Type of vertical interpolation method        
-!  n2dint                  Type of horizontal interpolation method       
-!  ln_nea                  Rejection of observations near land switch    
-!  nmsshc                  MSSH correction scheme                         
-!  mdtcorr                 MDT  correction                               
-!  mdtcutoff               MDT cutoff for computed correction          
-!  ln_altbias              Logical switch for alt bias                
-!  ln_ignmis               Logical switch for ignoring missing files   
-!  endailyavtypes          ENACT daily average types                    
- &namobs
-   ln_t3d = .true.
-   ln_s3d = .true.
-   ln_ena = .true.
-   enactfiles = 'enact.1.nc'
-   ln_grid_global = .true.
-   ln_grid_search_lookup = .true.
-   ln_ignmis = .true.  
-/ 
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namptr
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namptr	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namptr	(revision 6440)
@@ -3,9 +3,4 @@
 !-----------------------------------------------------------------------
    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/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namrun
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namrun	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namrun	(revision 6440)
@@ -9,15 +9,21 @@
    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
+   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_istate   =       0   !  output the initial state (1) or not (0)
+   ln_rst_list = .false.   !  output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F)
    nn_stock    =    5475   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_stocklist = 0,0,0,0,0,0,0,0,0,0 ! List of timesteps when a restart file is to be written
    nn_write    =    5475   !  frequency of write in the output file   (modulo referenced to nn_it000)
    ln_dimgnnn  = .false.   !  DIMG file format: 1 file for all processors (F) or by processor (T)
    ln_mskland  = .false.   !  mask land points in NetCDF outputs (costly: + ~15%)
+   ln_cfmeta   = .false.   !  output additional data to netCDF files required for compliance with the CF metadata standard
    ln_clobber  = .false.   !  clobber (overwrite) an existing file
    nn_chunksz  =       0   !  chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namsbc
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namsbc	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namsbc	(revision 6440)
@@ -9,14 +9,19 @@
    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_cpl      = .false.   !  atmosphere coupled   formulation          ( requires key_oasis3 )
+   ln_mixcpl   = .false.   !  forced-coupled mixed formulation          ( requires key_oasis3 )
+   nn_components = 0       !  configuration of the opa-sas OASIS coupling
+                           !  =0 no opa-sas OASIS coupling: default single executable configuration
+                           !  =1 opa-sas OASIS coupling: multi executable configuration, OPA component
+                           !  =2 opa-sas OASIS coupling: multi executable configuration, SAS component 
    ln_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 = 0         !  =0 levitating ice (no mass exchange, concentration/dilution effect)
+                           !  =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)
+   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
@@ -25,13 +30,16 @@
                            !  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
+   nn_lsm  = 0             !  =0 land/sea mask for input fields is not applied (keep empty land/sea mask filename field) ,
+                           !  =1:n number of iterations of land/sea mask application for input fields (fill land/sea mask filename field)
+   nn_limflx = -1          !  LIM3 Multi-category heat flux formulation (use -1 if LIM3 is not used)
+                           !  =-1  Use per-category fluxes, bypass redistributor, forced mode only, not yet implemented coupled
+                           !  = 0  Average per-category fluxes (forced and coupled mode)
+                           !  = 1  Average and redistribute per-category fluxes, forced mode only, not yet implemented coupled
+                           !  = 2  Redistribute a single flux over categories (coupled mode only)
 /
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namsbc_alb
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namsbc_alb	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namsbc_alb	(revision 6440)
@@ -2,8 +2,10 @@
 &namsbc_alb    !   albedo parameters
 !-----------------------------------------------------------------------
-   rn_cloud    =    0.06   !  cloud correction to snow and ice albedo
-   rn_albice   =    0.53   !  albedo of melting ice in the arctic and antarctic
-   rn_alphd    =    0.80   !  coefficients for linear interpolation used to
-   rn_alphc    =    0.65   !  compute albedo between two extremes values
-   rn_alphdi   =    0.72   !  (Pyane, 1972)
+   nn_ice_alb  =    0   !  parameterization of ice/snow albedo
+                        !     0: Shine & Henderson-Sellers (JGR 1985)
+                        !     1: "home made" based on Brandt et al. (J. Climate 2005)
+                        !                         and Grenfell & Perovich (JGR 2004)
+   rn_albice   =  0.53  !  albedo of bare puddled ice (values from 0.49 to 0.58)
+                        !     0.53 (default) => if nn_ice_alb=0
+                        !     0.50 (default) => if nn_ice_alb=1
 /
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namsbc_apr
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namsbc_apr	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namsbc_apr	(revision 6440)
@@ -2,10 +2,10 @@
 &namsbc_apr    !   Atmospheric pressure used as ocean forcing or in bulk
 !-----------------------------------------------------------------------
-!              ! 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/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namsbc_core
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namsbc_core	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namsbc_core	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namsbc_cpl
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namsbc_cpl	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namsbc_cpl	(revision 6440)
@@ -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  !
 ! 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/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namsbc_mfs
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namsbc_mfs	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namsbc_mfs	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namsbc_rnf
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namsbc_rnf	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namsbc_rnf	(revision 6440)
@@ -2,14 +2,13 @@
 &namsbc_rnf    !   runoffs namelist surface boundary condition
 !-----------------------------------------------------------------------
-!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
-!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
-   sn_rnf      = 'runoff_core_monthly',    -1    , 'sorunoff',   .true.     , .true. , 'yearly'  , ''       , ''       , ''
-   sn_cnf      = 'runoff_core_monthly',     0    , 'socoefr0',   .false.    , .true. , 'yearly'  , ''       , ''       , ''
-   sn_s_rnf    = 'runoffs'            ,    24    , 'rosaline',   .true.     , .true. , 'yearly'  , ''       , ''       , ''
-   sn_t_rnf    = 'runoffs'            ,    24    , 'rotemper',   .true.     , .true. , 'yearly'  , ''       , ''       , ''
-   sn_dep_rnf  = 'runoffs'            ,     0    , 'rodepth' ,   .false.    , .true. , 'yearly'  , ''       , ''       , ''
+!              !  file name           ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !                      !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_rnf      = 'runoff_core_monthly',        -1         , 'sorunoff',   .true.     , .true. , 'yearly'  , ''       , ''       , ''
+   sn_cnf      = 'runoff_core_monthly',         0         , 'socoefr0',   .false.    , .true. , 'yearly'  , ''       , ''       , ''
+   sn_s_rnf    = 'runoffs'            ,        24         , 'rosaline',   .true.     , .true. , 'yearly'  , ''       , ''       , ''
+   sn_t_rnf    = 'runoffs'            ,        24         , 'rotemper',   .true.     , .true. , 'yearly'  , ''       , ''       , ''
+   sn_dep_rnf  = 'runoffs'            ,         0         , 'rodepth' ,   .false.    , .true. , 'yearly'  , ''       , ''       , ''
 
    cn_dir       = './'      !  root directory for the location of the runoff files
-   ln_rnf_emp   = .false.   !  runoffs included into precipitation field (T) or into a file (F)
    ln_rnf_mouth = .true.    !  specific treatment at rivers mouths
    rn_hrnf      =  15.e0    !  depth over which enhanced vertical mixing is used
@@ -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/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namsbc_sas
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namsbc_sas	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namsbc_sas	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namsbc_wave
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namsbc_wave	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namsbc_wave	(revision 6440)
@@ -2,10 +2,10 @@
 &namsbc_wave   ! External fields from wave model
 !-----------------------------------------------------------------------
-!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
-!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
-   sn_cdg      =  'cdg_wave' ,        1          , 'drag_coeff' , .true.    , .false. , 'daily'  , ''       , ''       , ''
-   sn_usd      =  'sdw_wave' ,        1          , 'u_sd2d'     , .true.   , .false. , 'daily'  ,''         , ''       , ''
-   sn_vsd      =  'sdw_wave' ,        1          , 'v_sd2d'     , .true.   , .false. , 'daily'  ,''         , ''       , ''
-   sn_wn       =  'sdw_wave' ,        1          , 'wave_num'   , .true.   , .false. , 'daily'  ,''         , ''       , ''
+!              !  file name  ! frequency (hours) ! variable     ! time interp. !  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !             !  (if <0  months)  !   name       !   (logical)  !  (T/F)  ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_cdg      =  'cdg_wave' ,        1          , 'drag_coeff' ,     .true.   , .false. , 'daily'   ,  ''      , ''       , ''
+   sn_usd      =  'sdw_wave' ,        1          , 'u_sd2d'     ,     .true.   , .false. , 'daily'   ,  ''      , ''       , ''
+   sn_vsd      =  'sdw_wave' ,        1          , 'v_sd2d'     ,     .true.   , .false. , 'daily'   ,  ''      , ''       , ''
+   sn_wn       =  'sdw_wave' ,        1          , 'wave_num'   ,     .true.   , .false. , 'daily'   ,  ''      , ''       , ''
 !
    cn_dir_cdg  = './'  !  root directory for the location of drag coefficient files
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namsto
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namsto	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namsto	(revision 6440)
@@ -0,0 +1,17 @@
+!-----------------------------------------------------------------------
+&namsto       ! Stochastic parametrization of EOS
+!-----------------------------------------------------------------------
+   ln_rststo = .false.           ! start from mean parameter (F) or from restart file (T)
+   ln_rstseed = .true.           ! read seed of RNG from restart file
+   cn_storst_in  = "restart_sto" !  suffix of stochastic parameter restart file (input)
+   cn_storst_out = "restart_sto" !  suffix of stochastic parameter restart file (output)
+
+   ln_sto_eos = .false.          ! stochastic equation of state
+   nn_sto_eos = 1                ! number of independent random walks
+   rn_eos_stdxy = 1.4            ! random walk horz. standard deviation (in grid points)
+   rn_eos_stdz  = 0.7            ! random walk vert. standard deviation (in grid points)
+   rn_eos_tcor  = 1440.0         ! random walk time correlation (in timesteps)
+   nn_eos_ord  = 1               ! order of autoregressive processes
+   nn_eos_flt  = 0               ! passes of Laplacian filter
+   rn_eos_lim  = 2.0             ! limitation factor (default = 3.0)
+/
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namtra_adv
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namtra_adv	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namtra_adv	(revision 6440)
@@ -2,10 +2,11 @@
 &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_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
 /
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namtra_adv_mle
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namtra_adv_mle	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namtra_adv_mle	(revision 6440)
@@ -0,0 +1,13 @@
+!-----------------------------------------------------------------------
+&namtra_adv_mle !   mixed layer eddy parametrisation (Fox-Kemper param)
+!-----------------------------------------------------------------------
+   ln_mle    = .true.      ! (T) use the Mixed Layer Eddy (MLE) parameterisation
+   rn_ce     = 0.06        ! magnitude of the MLE (typical value: 0.06 to 0.08)
+   nn_mle    = 1           ! MLE type: =0 standard Fox-Kemper ; =1 new formulation
+   rn_lf     = 5.e+3       ! typical scale of mixed layer front (meters)                      (case rn_mle=0)
+   rn_time   = 172800.     ! time scale for mixing momentum across the mixed layer (seconds)  (case rn_mle=0)
+   rn_lat    = 20.         ! reference latitude (degrees) of MLE coef.                        (case rn_mle=1)
+   nn_mld_uv = 0           ! space interpolation of MLD at u- & v-pts (0=min,1=averaged,2=max)
+   nn_conv   = 0           ! =1 no MLE in case of convection ; =0 always MLE
+   rn_rho_c_mle  = 0.01    ! delta rho criterion used to calculate MLD for FK
+/
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namtra_bbc
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namtra_bbc	(revision 6439)
+++ 	(revision )
@@ -1,9 +1,0 @@
-!-----------------------------------------------------------------------
-&nambbc        !   bottom temperature boundary condition
-!-----------------------------------------------------------------------
-   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom
-   nn_geoflx   =    2      !  geothermal heat flux: = 0 no flux
-                           !     = 1 constant flux
-                           !     = 2 variable flux (read in geothermal_heating.nc in mW/m2)
-   rn_geoflx_cst = 86.4e-3 !  Constant value of geothermal heat flux [W/m2]
-/
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namtra_dmp
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namtra_dmp	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namtra_dmp	(revision 6440)
@@ -2,9 +2,8 @@
 &namtra_dmp    !   tracer: T & S newtonian damping
 !-----------------------------------------------------------------------
-   ln_tradmp   =  .true.     !  add a damping termn (T) or not (F)
-   nn_zdmp     =    0        !  vertical   shape =0    damping throughout the water column
-                             !                   =1 no damping in the mixing layer (kz  criteria)
-                             !                   =2 no damping in the mixed  layer (rho crieria)
-   cn_resto    = 'resto.nc'  ! Name of file containing restoration coefficient field (use dmp_tools to create this)
-
+   ln_tradmp   =  .true.   !  add a damping termn (T) or not (F)
+   nn_zdmp     =    0      !  vertical   shape =0    damping throughout the water column
+                           !                   =1 no damping in the mixing layer (kz  criteria)
+                           !                   =2 no damping in the mixed  layer (rho crieria)
+   cn_resto    = 'resto.nc' ! Name of file containing restoration coefficient field (use dmp_tools to create this)
 /
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namtra_qsr
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namtra_qsr	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namtra_qsr	(revision 6440)
@@ -11,7 +11,8 @@
    ln_qsr_2bd  = .false.   !  2 bands              light penetration
    ln_qsr_bio  = .false.   !  bio-model light penetration
-   nn_chldta   =      1    !  RGB : Chl data (=1) or cst value (=0)
+   nn_chldta   =      1    !  RGB : 2D Chl data (=1), 3D Chl data (=2) or cst value (=0)
    rn_abs      =   0.58    !  RGB & 2 bands: fraction of light (rn_si1)
    rn_si0      =   0.35    !  RGB & 2 bands: shortess depth of extinction
    rn_si1      =   23.0    !  2 bands: longest depth of extinction
+   ln_qsr_ice  = .true.    !  light penetration for ice-model LIM3
 /
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namtrd
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namtrd	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namtrd	(revision 6440)
@@ -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
+!              !       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/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namtsd
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namtsd	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namtsd	(revision 6440)
@@ -2,8 +2,9 @@
 &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/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namzdf_gls
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namzdf_gls	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namzdf_gls	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namzdf_tke
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namzdf_tke	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namzdf_tke	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namzgr_sco
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namzgr_sco	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/Namelist/namzgr_sco	(revision 6440)
@@ -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: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/namcfg_orca1
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/namcfg_orca1	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/namcfg_orca1	(revision 6440)
@@ -0,0 +1,12 @@
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "orca"               !  name of the configuration
+   jp_cfg      =       1               !  resolution of the configuration
+   jpidta      =     362               !  1st lateral dimension ( >= jpi )
+   jpjdta      =     292               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      75               !  number of levels      ( >= jpk )
+   jpiglo      =     362               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =     292               !  2nd    -                  -    --> j  =jpjdta
+   jperio      =       6               !  lateral cond. type (between 0 and 6)
+   ln_use_jattr = .true.               !  use (T) the file attribute: open_ocean_jstart if present
Index: branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/namelist_split.sh
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/namelist_split.sh	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/DOC/TexFiles/namelist_split.sh	(revision 6440)
@@ -0,0 +1,247 @@
+#! /bin/sh
+#
+#       usage for NEMO doc to create an update of the Namelist directory :
+# 1- delete the existing directory (You can also choose to save it somewhere) 
+#    rm -rf Namelist
+# 2- create the updated Namelist directory from the SHARED/namelist_ref :
+#    ./namelist_split.sh -i ../../NEMOGCM/CONFIG/SHARED/namelist_ref -o Namelist
+#
+# .. _namelist_split.sh:
+#
+# =================
+# namelist_split.sh
+# =================
+#
+# ----------------
+# split a namelist
+# ----------------
+#
+# SYNOPSIS
+# ========
+#
+# .. code-block:: bash
+#
+#    namelist_split.sh -i namelist -o dirout [-n]
+#
+# DESCRIPTION
+# ===========
+#
+# Split a namelist file (NEMO convention syntax) given in parameter
+# into files in a given output directory.
+#
+# .. option:: -i <input file (namelist)>
+# .. option:: -o <output directory>
+# .. option:: -n <numbered output files>
+#
+# Each file of the output directory is named after the *block* it contains.
+#
+# We assume here that the input file is written with this pattern of block:
+#
+# .. parsed-literal::
+#
+#    !---------------
+#    &nameblock
+#    !---------------
+#    var1 = val1
+#    ...
+#    varn = valn
+#    /
+#
+# If ``-n`` option is used, files in the directory output are named after
+# the number of the block it contains and the name of this block. This might
+# be useful to recombine blocks in the same order.
+#
+# EXAMPLES
+# ========
+#
+# To split the namelist NEMO ORCA2_LIM experiment 00 if you are in NEMO
+# working space :
+#
+# .. code-block:: bash
+#
+#    namelist_split.sh -i CONFIG/ORCA2_LIM/EXP00/namelist -o /tmp/EXP00_namelist_split/
+#
+# To split the namelist under data directory with numbered files:
+#
+# .. code-block:: bash
+#
+#    namelist_split.sh -i ./data/namelist -o /tmp/EXP00_namelist_split/ -n
+#
+# Check can be made by concatenation of files in output directory if ``-n``
+# option have been used and comparison with original file :
+#
+# .. code-block:: bash
+#
+#    cat /tmp/EXP00_namelist_split/b???_* > /tmp/EXP00_namelist_rebuild
+#    sdiff -w80 ./data/namelist /tmp/EXP00_namelist_rebuild
+#
+# Output contains lines which are before the first block, after the last
+# block and lines between blocks.
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+# - fplod 2008-08-11T08:56:44Z aedon.locean-ipsl.upmc.fr (Darwin)
+#
+#   * commentaires dans ce fichier en reStructuredText
+#     cf. reStructuredText_ and Docutils_
+#
+# .. _reStructuredText: http://docutils.sourceforge.net/rst.html
+# .. _Docutils: http://docutils.sourceforge.net/
+#
+# - fplod 2008-07-22T12:41:04Z aedon.locean-ipsl.upmc.fr (Darwin)
+#
+#   * creation with test on
+#     http://forge.ipsl.jussieu.fr/nemo/browser/trunk/CONFIG/ORCA2_LIM/EXP00/namelist revision 1151
+#-
+#
+system=$(uname)
+case "${system}" in
+    AIX|IRIX64)
+        echo " www : no specific posix checking"
+    ;;
+    *)
+        set -o posix
+    ;;
+esac
+unset system
+#
+command=$(basename ${0})
+log_date=$(date -u +"%Y%m%dT%H%M%SZ")
+#
+usage=" Usage : ${command} -i namelist -o dirout [-n]"
+#
+# default
+blocknum=0
+#
+minargcount=4
+if [ ${#} -lt ${minargcount} ]
+then
+    echo "eee : not enough arguments"
+    echo "${usage}"
+    exit 1
+fi
+#
+while [ ${#} -gt 0 ]
+do
+    case ${1} in
+        -i)
+            filein=${2}
+            shift
+        ;;
+        -o)
+            dirout=${2}
+            shift
+        ;;
+        -h)
+            echo "${usage}"
+            exit 0
+        ;;
+        -n)
+            blocknum=1
+        ;;
+        *)
+            # anything else
+            echo "eee : unknown option ${1}"
+            echo "eee : ${usage}"
+            exit 1
+        ;;
+    esac
+    # next flag
+    shift
+done
+unset usage
+#
+set -u
+#
+# check for filein
+if [ ! -r ${filein} ]
+then
+    echo "eee : ${filein} not accessible"
+    exit 1
+fi
+#
+# check for dirout
+# the idea is to prevent unwanted overwrite
+if [ -d ${dirout} ]
+then
+    echo "eee : ${dirout} already exist"
+    exit 1
+else
+    mkdir -p ${dirout}
+    if [ ${?} -ne 0 ]
+    then
+        echo "eee : cannot create ${dirout}"
+        exit 1
+    fi
+fi
+#
+# loop on each line of ${filein} ie the namelist to be split
+fileout=/dev/null
+begin=0
+if [ ${blocknum} -eq 1 ]
+then
+    iblock=0
+fi
+nbline=$(wc -l ${filein} | awk '{print $1}')
+il=1
+while [ ${il} -le ${nbline} ]
+do
+    line=$(sed -ne "${il},${il}p" ${filein})
+    # if current line start with "&", we can establish the name of output file
+    echo ${line} | grep -q "^&"
+    if [ ${?} -eq 0 ]
+    then
+        begin=1
+        # the form of this line is "&block   !"
+        block=${line#&}
+        block=${block%% *}
+        echo "iii : detection of the beginning of ${block}"
+        if [ ${blocknum} -eq 1 ]
+        then
+            iblock=$(( ${iblock} + 1))
+            fileout=${dirout}/b$(echo ${iblock} | awk '{printf "%3.3d", $1}')_${block}
+        else
+            fileout="${dirout}/${block}"
+        fi
+        # check for ${fileout}
+        if [ -f ${fileout} ]
+        then
+            echo "eee : ${fileout} already exists"
+            exit 1
+        fi
+        # write the previous line and the current line
+        echo "${memoline}" > ${fileout}
+        echo "${line}" >> ${fileout}
+    fi
+    # if current line contains "/" there will be no more lines to put in fileout
+    echo ${line} | grep -q "^/$"
+    if [ ${?} -eq 0 ]
+    then
+        echo "iii : detection of the end of ${block}"
+        echo "${line}" >> ${fileout}
+        fileout="/dev/null"
+    fi
+    # if current line is between "&" and "/", it should be written in fileout
+    # if current line is before the first &, it won't be written
+    if [ "${fileout}" != "/dev/null" ]
+    then
+        if [ ${begin} -eq 0 ]
+        then
+            echo "${line}" >> ${fileout}
+        fi
+    fi
+    # keep memory of this current line to use it if the next one is the
+    # beginning of a block
+    memoline=${line}
+    begin=0
+    # next line
+    il=$(( ${il} + 1 ))
+done
+#
+echo "iii : ${filein} is split in ${dirout}"
+#
+# end
+exit 0
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/CMCC/arch-PW6_calypso.fcm
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/CMCC/arch-PW6_calypso.fcm	(revision 6439)
+++ 	(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: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/CMCC/arch-PW6_calypso_debug.fcm
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/CMCC/arch-PW6_calypso_debug.fcm	(revision 6439)
+++ 	(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: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/CMCC/arch-PW6_calypso_tools.fcm
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/CMCC/arch-PW6_calypso_tools.fcm	(revision 6439)
+++ 	(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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/CMCC/arch-gfortran_athena_xios.fcm
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/CMCC/arch-gfortran_athena_xios.fcm	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/CMCC/arch-gfortran_athena_xios.fcm	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/CMCC/arch-ifort_athena.fcm
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/CMCC/arch-ifort_athena.fcm	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/CMCC/arch-ifort_athena.fcm	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/CMCC/arch-ifort_athena_debug.fcm
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/CMCC/arch-ifort_athena_debug.fcm	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/CMCC/arch-ifort_athena_debug.fcm	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/CMCC/arch-ifort_athena_tools.fcm
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/CMCC/arch-ifort_athena_tools.fcm	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/CMCC/arch-ifort_athena_tools.fcm	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/CMCC/arch-ifort_athena_xios.fcm
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/CMCC/arch-ifort_athena_xios.fcm	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/CMCC/arch-ifort_athena_xios.fcm	(revision 6440)
@@ -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:
@@ -35,12 +37,14 @@
 
 # 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
+#export NETCDF=/users/home/opt/netcdf/netcdf-4.3_parallel
 
-%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
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/INGV/arch-IBM_EKMAN_INGV.fcm
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/INGV/arch-IBM_EKMAN_INGV.fcm	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/INGV/arch-IBM_EKMAN_INGV.fcm	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-ALTIX_NAUTILUS_MPT.fcm
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-ALTIX_NAUTILUS_MPT.fcm	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-ALTIX_NAUTILUS_MPT.fcm	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-PW7_C2A_XIO.fcm
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-PW7_C2A_XIO.fcm	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-PW7_C2A_XIO.fcm	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-PW7_METO.fcm
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-PW7_METO.fcm	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-PW7_METO.fcm	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-PW7_MONSOON.fcm
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-PW7_MONSOON.fcm	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-PW7_MONSOON.fcm	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-X64_ADA.fcm
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-X64_ADA.fcm	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-X64_ADA.fcm	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-X64_ADA_O0.fcm
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-X64_ADA_O0.fcm	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-X64_ADA_O0.fcm	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-X64_CURIE.fcm
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-X64_CURIE.fcm	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-X64_CURIE.fcm	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-X64_MOBILIS.fcm
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-X64_MOBILIS.fcm	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-X64_MOBILIS.fcm	(revision 6440)
@@ -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:
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-X64_VAYU.fcm
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-X64_VAYU.fcm	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-X64_VAYU.fcm	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-X64_YELLOWSTONE.fcm
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-X64_YELLOWSTONE.fcm	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-X64_YELLOWSTONE.fcm	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-XC40_METO.fcm
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-XC40_METO.fcm	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-XC40_METO.fcm	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-XC_ARCHER.fcm
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-XC_ARCHER.fcm	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-XC_ARCHER.fcm	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-XC_ARCHER_INTEL.fcm
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-XC_ARCHER_INTEL.fcm	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-XC_ARCHER_INTEL.fcm	(revision 6440)
@@ -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:
@@ -55,2 +57,5 @@
 #USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
 #USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
+
+%CC                  cc
+%CFLAGS              -O0
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-macport_osx.fcm
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-macport_osx.fcm	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-macport_osx.fcm	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-openmpi_NAVITI_MERCATOR.fcm
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-openmpi_NAVITI_MERCATOR.fcm	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/ARCH/arch-openmpi_NAVITI_MERCATOR.fcm	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/AMM12/EXP00/namelist_cfg
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/AMM12/EXP00/namelist_cfg	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/AMM12/EXP00/namelist_cfg	(revision 6440)
@@ -200,8 +200,4 @@
 /
 !-----------------------------------------------------------------------
-&namobc        !   open boundaries parameters                           ("key_obc")
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
 &namagrif      !  AGRIF zoom                                            ("key_agrif")
 !-----------------------------------------------------------------------
@@ -369,4 +365,8 @@
 /
 !-----------------------------------------------------------------------
+&namzdf_tmx_new !  new tidal mixing parameterization                    ("key_zdftmx_new")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
 &namsol        !   elliptic solver / island / free surface
 !-----------------------------------------------------------------------
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/C1D_PAPA/EXP00/namelist_cfg
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/C1D_PAPA/EXP00/namelist_cfg	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/C1D_PAPA/EXP00/namelist_cfg	(revision 6440)
@@ -141,4 +141,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'  , ''       , ''       , ''
 /
 !-----------------------------------------------------------------------
@@ -173,8 +176,4 @@
 !-----------------------------------------------------------------------
 &namcla        !   cross land advection
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namobc        !   open boundaries parameters                           ("key_obc")
 !-----------------------------------------------------------------------
 /
@@ -304,4 +303,8 @@
 /
 !-----------------------------------------------------------------------
+&namzdf_tmx_new !  new tidal mixing parameterization                    ("key_zdftmx_new")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
 &namsol        !   elliptic solver / island / free surface
 !-----------------------------------------------------------------------
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/GYRE/EXP00/namelist_cfg
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/GYRE/EXP00/namelist_cfg	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/GYRE/EXP00/namelist_cfg	(revision 6440)
@@ -160,8 +160,4 @@
 /
 !-----------------------------------------------------------------------
-&namobc        !   open boundaries parameters                           ("key_obc")
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
 &namagrif      !  AGRIF zoom                                            ("key_agrif")
 !-----------------------------------------------------------------------
@@ -304,4 +300,8 @@
 /
 !-----------------------------------------------------------------------
+&namzdf_tmx_new !  new tidal mixing parameterization                    ("key_zdftmx_new")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
 &namsol        !   elliptic solver / island / free surface
 !-----------------------------------------------------------------------
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_cfg
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_cfg	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_cfg	(revision 6440)
@@ -165,8 +165,4 @@
 /
 !-----------------------------------------------------------------------
-&namobc        !   open boundaries parameters                           ("key_obc")
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
 &namagrif      !  AGRIF zoom                                            ("key_agrif")
 !-----------------------------------------------------------------------
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/domain_def.xml
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/domain_def.xml	(revision 6439)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../../SHARED/domain_def.xml
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/file_def.xml
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/file_def.xml	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/file_def.xml	(revision 6440)
@@ -0,0 +1,65 @@
+    <!-- 
+============================================================================================================
+=                                           output files definition                                        =
+=                                            Define your own files                                         =
+=                                         put the variables you want...                                    =
+============================================================================================================
+    -->
+    
+    <file_definition type="one_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="1d" min_digits="4">
+    
+      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files -->
+      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."/> <!-- 1h files -->
+      <file_group id="2h" output_freq="2h"  output_level="10" enabled=".TRUE."/> <!-- 2h files -->
+      <file_group id="3h" output_freq="3h"  output_level="10" enabled=".TRUE."/> <!-- 3h files -->     
+      <file_group id="4h" output_freq="4h"  output_level="10" enabled=".TRUE."/> <!-- 4h files -->
+      <file_group id="6h" output_freq="6h"  output_level="10" enabled=".TRUE."/> <!-- 6h files -->
+     
+      <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."/> <!-- 1d files -->
+      <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->    
+      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE.">  <!-- 5d files -->  
+ 
+	<file id="file1" name_suffix="_grid_T" description="ocean T grid variables" >
+	  <field field_ref="toce"         name="votemper"  />
+	  <field field_ref="soce"         name="vosaline"  />
+	  <field field_ref="sst"          name="sosstsst"  />
+	  <field field_ref="sss"          name="sosaline"  />
+	  <field field_ref="ssh"          name="sossheig"  />
+	  <field field_ref="empmr"        name="sowaflup"  />
+	  <field field_ref="qsr"          name="soshfldo"  />
+      <field field_ref="saltflx"      name="sosfldow"  />
+	  <field field_ref="qt"           name="sohefldo"  />
+	  <field field_ref="mldr10_1"     name="somxl010"  />
+	  <field field_ref="mldkz5"       name="somixhgt"  />
+    </file>
+	
+	<file id="file2" name_suffix="_grid_U" description="ocean U grid variables" >
+          <field field_ref="uoce"         name="vozocrtx"  />
+          <field field_ref="utau"         name="sozotaux"  />
+    </file>
+	
+	<file id="file3" name_suffix="_grid_V" description="ocean V grid variables" >
+          <field field_ref="voce"         name="vomecrty"  /> 
+          <field field_ref="vtau"         name="sometauy"  /> 
+    </file>
+	
+	<file id="file4" name_suffix="_grid_W" description="ocean W grid variables" >
+          <field field_ref="woce"         name="vovecrtz" />
+          <field field_ref="avt"          name="votkeavt" />
+          <field field_ref="aht2d"        name="soleahtw" />
+    </file>
+
+      </file_group>
+      
+      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files -->
+      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files -->
+      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files -->
+      <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files -->
+      <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files -->
+
+      <file_group id="1y"  output_freq="1y" output_level="10" enabled=".TRUE."/> <!-- real yearly files -->
+      <file_group id="2y"  output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files -->
+      <file_group id="5y"  output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files -->
+      <file_group id="10y" output_freq="10y" output_level="10" enabled=".TRUE."/> <!-- real 10y files -->
+
+   </file_definition>
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/iodef.xml
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/iodef.xml	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/iodef.xml	(revision 6440)
@@ -2,5 +2,5 @@
 <simulation> 
 
- <context id="nemo" time_origin="1900-01-01 00:00:00" >
+ <context id="nemo" >
     
     <!-- $id$ -->
@@ -19,65 +19,10 @@
 =                                         put the variables you want...                                    =
 ============================================================================================================
-    -->
-    
-    <file_definition type="multiple_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="1d" min_digits="4">
-    
-      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files -->
-      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."/> <!-- 1h files -->
-      <file_group id="2h" output_freq="2h"  output_level="10" enabled=".TRUE."/> <!-- 2h files -->
-      <file_group id="3h" output_freq="3h"  output_level="10" enabled=".TRUE."/> <!-- 3h files -->     
-      <file_group id="4h" output_freq="4h"  output_level="10" enabled=".TRUE."/> <!-- 4h files -->
-      <file_group id="6h" output_freq="6h"  output_level="10" enabled=".TRUE."/> <!-- 6h files -->
-     
-      <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."/> <!-- 1d files -->
-      <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->    
-      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE.">  <!-- 5d files -->  
+       -->
+
+    <file_definition src="./file_def.xml"/>
+
+    <!--
  
-	<file id="file1" name_suffix="_grid_T" description="ocean T grid variables" >
-	  <field field_ref="toce"         name="votemper"  />
-	  <field field_ref="soce"         name="vosaline"  />
-	  <field field_ref="sst"          name="sosstsst"  />
-	  <field field_ref="sss"          name="sosaline"  />
-	  <field field_ref="ssh"          name="sossheig"  />
-	  <field field_ref="empmr"        name="sowaflup"  />
-	  <field field_ref="qsr"          name="soshfldo"  />
-      <field field_ref="saltflx"      name="sosfldow"  />
-	  <field field_ref="qt"           name="sohefldo"  />
-	  <field field_ref="mldr10_1"     name="somxl010"  />
-	  <field field_ref="mldkz5"       name="somixhgt"  />
-    </file>
-	
-	<file id="file2" name_suffix="_grid_U" description="ocean U grid variables" >
-          <field field_ref="uoce"         name="vozocrtx"  />
-          <field field_ref="utau"         name="sozotaux"  />
-    </file>
-	
-	<file id="file3" name_suffix="_grid_V" description="ocean V grid variables" >
-          <field field_ref="voce"         name="vomecrty"  /> 
-          <field field_ref="vtau"         name="sometauy"  /> 
-    </file>
-	
-	<file id="file4" name_suffix="_grid_W" description="ocean W grid variables" >
-          <field field_ref="woce"         name="vovecrtz" />
-          <field field_ref="avt"          name="votkeavt" />
-          <field field_ref="aht2d"        name="soleahtw" />
-    </file>
-
-      </file_group>
-      
-      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files -->
-      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files -->
-      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files -->
-      <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files -->
-      <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files -->
-
-      <file_group id="1y"  output_freq="1y" output_level="10" enabled=".TRUE."/> <!-- real yearly files -->
-      <file_group id="2y"  output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files -->
-      <file_group id="5y"  output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files -->
-      <file_group id="10y" output_freq="10y" output_level="10" enabled=".TRUE."/> <!-- real 10y files -->
-
-   </file_definition>
-    
-    <!-- 
 ============================================================================================================
 = grid definition = = DO NOT CHANGE =
@@ -100,12 +45,34 @@
    
    <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="grid_T_2D" >
+       <domain id="grid_T" />
+     </grid>
+     <grid id="grid_T_3D" >
+       <domain id="grid_T" />
+       <axis id="deptht" />
+     </grid>
+     <grid id="grid_U_2D" >
+       <domain id="grid_U" />
+     </grid>
+     <grid id="grid_U_3D" >
+       <domain id="grid_U" />
+       <axis id="depthu" />
+     </grid>
+     <grid id="grid_V_2D" >
+       <domain id="grid_V" />
+     </grid>
+     <grid id="grid_V_3D" >
+       <domain id="grid_V" />
+       <axis id="depthv" />
+     </grid>
+     <grid id="grid_W_2D" >
+       <domain id="grid_W" />
+     </grid>
+     <grid id="grid_W_3D" >
+       <domain id="grid_W" />
+       <axis id="depthw" />
+     </grid>
+     <grid id="scalarpoint" />
+
     </grid_definition> 
 
@@ -120,9 +87,7 @@
         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="info_level"                type="int">0</variable>
+	  <variable id="using_server"              type="bool">false</variable>
+	  <variable id="using_oasis"               type="bool">false</variable>
 	  <variable id="oasis_codes_id"            type="string" >oceanx</variable>
 	
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/namelist_cfg
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/namelist_cfg	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/namelist_cfg	(revision 6440)
@@ -154,8 +154,4 @@
 /
 !-----------------------------------------------------------------------
-&namobc        !   open boundaries parameters                           ("key_obc")
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
 &namagrif      !  AGRIF zoom                                            ("key_agrif")
 !-----------------------------------------------------------------------
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/GYRE_XIOS/cpp_GYRE_XIOS.fcm
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/GYRE_XIOS/cpp_GYRE_XIOS.fcm	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/GYRE_XIOS/cpp_GYRE_XIOS.fcm	(revision 6440)
@@ -1,1 +1,1 @@
- bld::tool::fppkeys key_dynspg_flt key_ldfslp key_zdftke key_iomput key_mpp_mpi
+ bld::tool::fppkeys key_dynspg_flt key_ldfslp key_zdftke key_iomput key_mpp_mpi key_xios2
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist_cfg
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist_cfg	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist_cfg	(revision 6440)
@@ -6,5 +6,5 @@
 !-----------------------------------------------------------------------
    cn_exp      = "Agulhas" !  experience name 
-   nn_itend    =     480   !  last  time step
+   nn_itend    =   10950   !  last  time step
    nn_stock    =   10950   !  frequency of creation of a restart file (modulo referenced to 1)
    nn_write    =   10950   !  frequency of write in the output file   (modulo referenced to nn_it000)
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist_cfg
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist_cfg	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist_cfg	(revision 6440)
@@ -165,4 +165,8 @@
 /
 !-----------------------------------------------------------------------
+&namzdf_tmx_new !  new tidal mixing parameterization                    ("key_zdftmx_new")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
 &namsol        !   elliptic solver / island / free surface
 !-----------------------------------------------------------------------
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef.xml
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef.xml	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef.xml	(revision 6440)
@@ -61,4 +61,6 @@
 	<file id="file2" name_suffix="_SBC" description="surface fluxes variables" > <!-- time step automaticaly defined based on nn_fsbc -->
 	  <field field_ref="empmr"        name="wfo"      />
+          <field field_ref="emp_oce"      name="emp_oce"  long_name="Evap minus Precip over ocean"              />
+          <field field_ref="emp_ice"      name="emp_ice"  long_name="Evap minus Precip over ice"                />
 	  <field field_ref="qsr_oce"      name="qsr_oce"  />
 	  <field field_ref="qns_oce"      name="qns_oce"  />
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/namelist_cfg
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/namelist_cfg	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/namelist_cfg	(revision 6440)
@@ -168,4 +168,8 @@
 /
 !-----------------------------------------------------------------------
+&namzdf_tmx_new !  new tidal mixing parameterization                    ("key_zdftmx_new")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
 &namsol        !   elliptic solver / island / free surface
 !-----------------------------------------------------------------------
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/1_namelist_cfg
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/1_namelist_cfg	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/1_namelist_cfg	(revision 6440)
@@ -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, namcla, namagrif, nambdy, nambdy_tide)
 !!              5 - bottom  boundary (nambfr, nambbc, nambbl)
 !!              6 - Tracer           (nameos, namtra_adv, namtra_ldf, namtra_dmp)
@@ -303,5 +303,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")
@@ -319,25 +318,4 @@
 !-----------------------------------------------------------------------
    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
 /
 !-----------------------------------------------------------------------
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/namelist_cfg
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/namelist_cfg	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/namelist_cfg	(revision 6440)
@@ -136,8 +136,4 @@
 /
 !-----------------------------------------------------------------------
-&namobc        !   open boundaries parameters                           ("key_obc")
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
 &namagrif      !  AGRIF zoom                                            ("key_agrif")
 !-----------------------------------------------------------------------
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_cfg
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_cfg	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_cfg	(revision 6440)
@@ -165,4 +165,8 @@
 /
 !-----------------------------------------------------------------------
+&namzdf_tmx_new !  new tidal mixing parameterization                    ("key_zdftmx_new")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
 &namsol        !   elliptic solver / island / free surface
 !-----------------------------------------------------------------------
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/SHARED/field_def.xml
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/SHARED/field_def.xml	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/SHARED/field_def.xml	(revision 6440)
@@ -23,4 +23,5 @@
       <field_group id="grid_T" grid_ref="grid_T_2D" >
          <field id="e3t"          long_name="T-cell thickness"   standard_name="cell_thickness"   unit="m"   grid_ref="grid_T_3D"/>
+         <field id="e3t_0"        long_name="Initial T-cell thickness"   standard_name="ref_cell_thickness"   unit="m"   grid_ref="grid_T_3D"/>
 
          <field id="toce"         long_name="temperature"         standard_name="sea_water_potential_temperature"   unit="degC"     grid_ref="grid_T_3D"/>
@@ -59,5 +60,4 @@
          <field id="alpha"        long_name="thermal expansion"                                                         unit="degC-1" grid_ref="grid_T_3D" />
          <field id="beta"         long_name="haline contraction"                                                        unit="1e3"    grid_ref="grid_T_3D" />
-         <field id="bn2"          long_name="squared Brunt-Vaisala frequency"                                           unit="s-1"    grid_ref="grid_T_3D" />
          <field id="rhop"         long_name="potential density (sigma0)"        standard_name="sea_water_sigma_theta"   unit="kg/m3"  grid_ref="grid_T_3D" />
 
@@ -174,4 +174,7 @@
       <field_group id="SBC" grid_ref="grid_T_2D" > <!-- time step automaticaly defined based on nn_fsbc -->
          <field id="empmr"        long_name="Net Upward Water Flux"                standard_name="water_flux_out_of_sea_ice_and_sea_water"                              unit="kg/m2/s"   />
+         <field id="empbmr"       long_name="Net Upward Water Flux at pre. tstep"  standard_name="water_flux_out_of_sea_ice_and_sea_water"                              unit="kg/m2/s"   />
+         <field id="emp_oce"      long_name="Evap minus Precip over ocean"         standard_name="evap_minus_precip_over_sea_water"                                     unit="kg/m2/s"   />
+         <field id="emp_ice"      long_name="Evap minus Precip over ice"           standard_name="evap_minus_precip_over_sea_ice"                                       unit="kg/m2/s"   />
          <field id="saltflx"      long_name="Downward salt flux"                                                                                                        unit="1e-3/m2/s" />
          <field id="fmmflx"       long_name="Water flux due to freezing/melting"                                                                                        unit="kg/m2/s"   />
@@ -274,4 +277,6 @@
          <field id="micesalt"     long_name="Mean ice salinity"                                                                                                               unit="1e-3"         />
          <field id="miceage"      long_name="Mean ice age"                                                                                                                    unit="years"        />
+         <field id="alb_ice"      long_name="Mean albedo over sea ice"                                                                                                        unit=""             />
+         <field id="albedo"       long_name="Mean albedo over sea ice and ocean"                                                                                              unit=""             />
 
          <field id="iceage_cat"   long_name="Ice age for categories"                                       unit="days"   axis_ref="ncatice" />
@@ -311,4 +316,5 @@
          <field id="sfxsni"       long_name="salt flux from snow-ice formation"                            unit="1e-3*kg/m2/day" />
          <field id="sfxopw"       long_name="salt flux from open water ice formation"                      unit="1e-3*kg/m2/day" />
+         <field id="sfxsub"       long_name="salt flux from sublimation"                                   unit="1e-3*kg/m2/day" />
          <field id="sfx"          long_name="salt flux total"                                              unit="1e-3*kg/m2/day" />
 
@@ -324,4 +330,5 @@
          <field id="vfxsub"       long_name="snw sublimation"                                              unit="m/day"   />
          <field id="vfxspr"       long_name="snw precipitation on ice"                                     unit="m/day"   />
+         <field id="vfxthin"      long_name="daily thermo ice prod. for thin ice(<20cm) + open water"      unit="m/day"   />
 
          <field id="afxtot"       long_name="area tendency (total)"                                        unit="day-1"   />
@@ -365,4 +372,5 @@
       <field_group id="grid_U"   grid_ref="grid_U_2D">
          <field id="e3u"          long_name="U-cell thickness"                                       standard_name="cell_thickness"              unit="m"          grid_ref="grid_U_3D" />
+         <field id="e3u_0"        long_name="Initial U-cell thickness"                               standard_name="ref_cell_thickness"          unit="m"          grid_ref="grid_U_3D"/>
          <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" />
@@ -400,4 +408,5 @@
       <field_group id="grid_V"   grid_ref="grid_V_2D">
          <field id="e3v"          long_name="V-cell thickness"                                       standard_name="cell_thickness"              unit="m"          grid_ref="grid_V_3D" />
+         <field id="e3v_0"        long_name="Initial V-cell thickness"                               standard_name="ref_cell_thickness"          unit="m"          grid_ref="grid_V_3D"/>
          <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" />
@@ -441,10 +450,11 @@
         <field id="woce_eiv"     long_name="EIV ocean vertical velocity"   standard_name="bolus_upward_sea_water_velocity"   unit="m/s" />
 
-        <!-- woce_eiv: available with key_trabbl_adv -->
         <field id="avt"          long_name="vertical eddy diffusivity"   standard_name="ocean_vertical_heat_diffusivity"       unit="m2/s" />
+        <field id="logavt"       long_name="logarithm of vertical eddy diffusivity"   standard_name="ocean_vertical_heat_diffusivity"       unit="m2/s" />
         <field id="avm"          long_name="vertical eddy viscosity"     standard_name="ocean_vertical_momentum_diffusivity"   unit="m2/s" />
 
         <!-- avs: available with key_zdfddm -->
         <field id="avs"          long_name="salt vertical eddy diffusivity"   standard_name="ocean_vertical_salt_diffusivity"   unit="m2/s" />
+        <field id="logavs"       long_name="logarithm of salt vertical eddy diffusivity"   standard_name="ocean_vertical_heat_diffusivity"       unit="m2/s" />
 
         <!-- avt_evd and avm_evd: available with ln_zdfevd -->
@@ -454,4 +464,12 @@
         <!-- avt_tide: available with key_zdftmx -->
         <field id="av_tide"      long_name="tidal vertical diffusivity"   standard_name="ocean_vertical_tracer_diffusivity_due_to_tides"   unit="m2/s" />
+
+       <!-- variables available with key_zdftmx_new -->
+        <field id="av_ratio"     long_name="S over T diffusivity ratio"            standard_name="salinity_over_temperature_diffusivity_ratio"                     unit="1"    />
+        <field id="av_wave"      long_name="wave-induced vertical diffusivity"     standard_name="ocean_vertical_tracer_diffusivity_due_to_internal_waves"         unit="m2/s" />
+        <field id="bn2"          long_name="squared Brunt-Vaisala frequency"       standard_name="squared_brunt_vaisala_frequency"                                 unit="s-1"  />
+        <field id="bflx_tmx"     long_name="wave-induced buoyancy flux"            standard_name="buoyancy_flux_due_to_internal_waves"                             unit="W/kg" />
+        <field id="pcmap_tmx"    long_name="power consumed by wave-driven mixing"  standard_name="vertically_integrated_power_consumption_by_wave_driven_mixing"   unit="W/m2"      grid_ref="grid_W_2D" />
+        <field id="emix_tmx"     long_name="power density available for mixing"    standard_name="power_available_for_mixing_from_breaking_internal_waves"         unit="W/kg" />
 
         <!-- variables available with key_diaar5 -->   
@@ -527,4 +545,5 @@
          <field id="ibgsfxbom"    long_name="global mean salt flux (thermo)"                         unit="1e-3*m/day" />
          <field id="ibgsfxsum"    long_name="global mean salt flux (thermo)"                         unit="1e-3*m/day" />
+         <field id="ibgsfxsub"    long_name="global mean salt flux (thermo)"                         unit="1e-3*m/day" />
 
          <field id="ibghfxdhc"    long_name="Heat content variation in snow and ice"                 unit="W"          />
@@ -849,5 +868,8 @@
        <field id="Totlig"      long_name="Total ligand concentation"               unit="nmol/m3"    grid_ref="grid_T_3D" />
        <field id="Biron"       long_name="Bioavailable iron"                       unit="nmol/m3"    grid_ref="grid_T_3D" />
-       <field id="Sdenit"      long_name="Nitrate reduction in the sediments"      unit="mol/m2/s"                        />
+       <field id="Sdenit"      long_name="Nitrate reduction in the sediments"      unit="molN/m2/s"                       />
+       <field id="SedCal"      long_name="Calcite burial in the sediments"         unit="molC/m2/s"                       />
+       <field id="SedSi"       long_name="Silicon burial in the sediments"         unit="molSi/m2/s"                      />
+       <field id="SedC"        long_name="Organic C burial in the sediments"       unit="molC/m2/s"                       />
        <field id="Ironice"     long_name="Iron input/uptake due to sea ice"        unit="mol/m2/s"                        />
        <field id="HYDR"        long_name="Iron input from hydrothemal vents"       unit="mol/m2/s"   grid_ref="grid_T_3D" />
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/SHARED/namelist_ice_lim3_ref
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/SHARED/namelist_ice_lim3_ref	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/SHARED/namelist_ice_lim3_ref	(revision 6440)
@@ -21,5 +21,6 @@
    cn_icerst_outdir = "."          !  directory in which to write output ice restarts
    ln_limdyn     = .true.          !  ice dynamics (T) or thermodynamics only (F)
-   rn_amax       = 0.999           !  maximum tolerated ice concentration 
+   rn_amax_n     = 0.999           !  maximum tolerated ice concentration NH
+   rn_amax_s     = 0.999           !  maximum tolerated ice concentration SH
    ln_limdiahsb  = .false.         !  check the heat and salt budgets (T) or not (F)
    ln_limdiaout  = .true.          !  output the heat and salt budgets (T) or not (F)
@@ -85,5 +86,5 @@
    rn_hnewice  = 0.1               !  thickness for new ice formation in open water (m)
    ln_frazil   = .false.           !  use frazil ice collection thickness as a function of wind (T) or not (F)
-   rn_maxfrazb = 0.0               !  maximum fraction of frazil ice collecting at the ice base
+   rn_maxfrazb = 1.0               !  maximum fraction of frazil ice collecting at the ice base
    rn_vfrazb   = 0.417             !  thresold drift speed for frazil ice collecting at the ice bottom (m/s)
    rn_Cfrazb   = 5.0               !  squeezing coefficient for frazil ice collecting at the ice bottom
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/SHARED/namelist_ref
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/SHARED/namelist_ref	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/SHARED/namelist_ref	(revision 6440)
@@ -5,9 +5,9 @@
 !!                                    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, namcla, namagrif, nambdy, nambdy_tide)
 !!              5 - bottom  boundary (nambfr, nambbc, nambbl)
 !!              6 - Tracer           (nameos, namtra_adv, namtra_ldf, 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_kpp, namzdf_ddm, namzdf_tmx, namzdf_tmx_new)
 !!              9 - diagnostics      (namnc4, namtrd, namspr, namflo, namhsb, namsto)
 !!             10 - miscellaneous    (namsol, nammpp, namctl)
@@ -408,5 +408,5 @@
    ln_qsr_2bd  = .false.   !  2 bands              light penetration
    ln_qsr_bio  = .false.   !  bio-model light penetration
-   nn_chldta   =      1    !  RGB : Chl data (=1) or cst value (=0)
+   nn_chldta   =      1    !  RGB : 2D Chl data (=1), 3D Chl data (=2) or cst value (=0)
    rn_abs      =   0.58    !  RGB & 2 bands: fraction of light (rn_si1)
    rn_si0      =   0.35    !  RGB & 2 bands: shortess depth of extinction
@@ -500,9 +500,11 @@
 &namsbc_alb    !   albedo parameters
 !-----------------------------------------------------------------------
-   rn_cloud    =    0.06   !  cloud correction to snow and ice albedo
-   rn_albice   =    0.53   !  albedo of melting ice in the arctic and antarctic
-   rn_alphd    =    0.80   !  coefficients for linear interpolation used to
-   rn_alphc    =    0.65   !  compute albedo between two extremes values
-   rn_alphdi   =    0.72   !  (Pyane, 1972)
+   nn_ice_alb  =    0   !  parameterization of ice/snow albedo
+                        !     0: Shine & Henderson-Sellers (JGR 1985)
+                        !     1: "home made" based on Brandt et al. (J. Climate 2005)
+                        !                         and Grenfell & Perovich (JGR 2004)
+   rn_albice   =  0.53  !  albedo of bare puddled ice (values from 0.49 to 0.58)
+                        !     0.53 (default) => if nn_ice_alb=0
+                        !     0.50 (default) => if nn_ice_alb=1
 /
 !-----------------------------------------------------------------------
@@ -546,5 +548,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")
@@ -563,25 +564,4 @@
 !-----------------------------------------------------------------------
    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
 /
 !-----------------------------------------------------------------------
@@ -898,10 +878,11 @@
 !!             Tracers & Dynamics vertical physics namelists
 !!======================================================================
-!!    namzdf        vertical physics
-!!    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_ddm    double diffusive mixing parameterization            ("key_zdfddm")
-!!    namzdf_tmx    tidal mixing parameterization                       ("key_zdftmx")
+!!    namzdf            vertical physics
+!!    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_ddm        double diffusive mixing parameterization        ("key_zdfddm")
+!!    namzdf_tmx        tidal mixing parameterization                   ("key_zdftmx")
+!!    namzdf_tmx_new    new tidal mixing parameterization               ("key_zdftmx_new")
 !!======================================================================
 !
@@ -1010,5 +991,11 @@
    rn_tfe_itf  = 1.        !  ITF tidal dissipation efficiency
 /
-
+!-----------------------------------------------------------------------
+&namzdf_tmx_new    !   new tidal mixing parameterization                ("key_zdftmx_new")
+!-----------------------------------------------------------------------
+   nn_zpyc     = 1         !  pycnocline-intensified dissipation scales as N (=1) or N^2 (=2)
+   ln_mevar    = .true.    !  variable (T) or constant (F) mixing efficiency
+   ln_tsdiff   = .true.    !  account for differential T/S mixing (T) or not (F)
+/
 !!======================================================================
 !!                  ***  Miscellaneous namelists  ***
@@ -1196,59 +1183,52 @@
    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_cor     = .false.    ! 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_ssh     = .false.    ! Logical switch for SSH observations
+   ln_sst     = .false.    ! Logical switch for SST observations
+   ln_reysst  = .false.    ! Logical switch for Reynolds observations
+   ln_ghrsst  = .false.    ! Logical switch for GHRSST observations
    ln_sstfb   = .false.    ! Logical switch for feedback SST data
-                           !     ln_sss                  Logical switch for SSS observations
+   ln_sss     = .false.    ! 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_vel3d   = .false.    ! Logical switch for velocity observations
+   ln_velavcur= .false     ! Logical switch for velocity daily av. cur.
+   ln_velhrcur= .false     ! Logical switch for velocity high freq. cur.
+   ln_velavadcp = .false.  ! Logical switch for velocity daily av. ADCP
+   ln_velhradcp = .false.  ! Logical switch for velocity high freq. ADCP
+   ln_velfb   = .false.    ! Logical switch for feedback velocity data
+   ln_grid_global = .false. ! Global distribtion of observations
+   ln_grid_search_lookup = .false. !  Logical switch for obs grid search w/lookup table
+   grid_search_file = 'grid_search'  !  Grid search lookup file header
+! All of the *files* variables below are arrays. Use namelist_cfg to add more files
+   enactfiles = 'enact.nc' !  ENACT input observation file names (specify full array in namelist_cfg)
+   coriofiles = 'corio.nc' !  Coriolis input observation file name
+   profbfiles = 'profiles_01.nc' ! Profile feedback input observation file name
+   ln_profb_enatim = .false !        Enact feedback input time setting switch
+   slafilesact = 'sla_act.nc' !  Active SLA input observation file names
+   slafilespas = 'sla_pass.nc' ! Passive SLA input observation file names
+   slafbfiles = 'sla_01.nc' ! slafbfiles: Feedback SLA input observation file names
+   sstfiles = 'ghrsst.nc'   ! GHRSST input observation file names
+   sstfbfiles = 'sst_01.nc' ! Feedback SST input observation file names
+   seaicefiles = 'seaice_01.nc' ! Sea Ice input observation file names
+   velavcurfiles = 'velavcurfile.nc'  ! Vel. cur. daily av. input file name
+   velhrcurfiles = 'velhrcurfile.nc'  ! Vel. cur. high freq. input file name
+   velavadcpfiles = 'velavadcpfile.nc' ! Vel. ADCP daily av. input file name
+   velhradcpfiles = 'velhradcpfile.nc' ! Vel. ADCP high freq. input file name
+   velfbfiles = 'velfbfile.nc' ! Vel. feedback input observation file name
+   dobsini = 20000101.000000  !  Initial date in window YYYYMMDD.HHMMSS
+   dobsend = 20010101.000000  !  Final date in window YYYYMMDD.HHMMSS
+   n1dint = 0  !               Type of vertical interpolation method
+   n2dint = 0  !               Type of horizontal interpolation method
+   ln_nea = .false.   !        Rejection of observations near land switch
+   nmsshc     = 0     !        MSSH correction scheme
+   mdtcorr = 1.61     !        MDT  correction
+   mdtcutoff = 65.0   !        MDT cutoff for computed correction
    ln_altbias = .false.    ! Logical switch for alt bias
    ln_ignmis  = .true.     ! Logical switch for ignoring missing files
-                           !     endailyavtypes   ENACT daily average types
+   endailyavtypes = 820    ! ENACT daily average types - array (use namelist_cfg to set more values)
    ln_grid_global = .true.
    ln_grid_search_lookup = .false.
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/SHARED/namelist_top_ref
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/SHARED/namelist_top_ref	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/SHARED/namelist_top_ref	(revision 6440)
@@ -62,4 +62,5 @@
    rn_ahtrc_0       =  2000.    !  horizontal eddy diffusivity for tracers [m2/s]
    rn_ahtrb_0       =     0.    !     background eddy diffusivity for ldf_iso [m2/s]
+   rn_fact_lap      =     1.    !     enhanced zonal eddy diffusivity
 /
 !-----------------------------------------------------------------------
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/cfg.txt
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/cfg.txt	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/CONFIG/cfg.txt	(revision 6440)
@@ -6,7 +6,7 @@
 GYRE_BFM OPA_SRC TOP_SRC
 AMM12 OPA_SRC
+ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC
 ORCA2_LIM_PISCES OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC
+ORCA2_LIM3 OPA_SRC LIM_SRC_3 NST_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
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F	(revision 6439)
+++ 	(revision )
@@ -1,1175 +1,0 @@
-!
-! $Id: modarrays.F 2715 2011-03-30 15:58:35Z rblod $
-!
-C     AGRIF (Adaptive Grid Refinement In Fortran)
-C
-C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
-C
-C     This program is free software; you can redistribute it and/or modify
-C     it under the terms of the GNU General Public License as published by
-C     the Free Software Foundation; either version 2 of the License, or
-C     (at your option) any later version.
-C
-C     This program is distributed in the hope that it will be useful,
-C     but WITHOUT ANY WARRANTY; without even the implied warranty of
-C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-C     GNU General Public License for more details.
-C
-C     You should have received a copy of the GNU General Public License
-C     along with this program; if not, write to the Free Software
-C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
-C
-C
-C
-CCC   Module Agrif_Arrays
-C      
-      Module Agrif_Arrays
-      Use Agrif_Types
-C
-      implicit none
-C      
-      Contains
-C     **************************************************************************
-CCC   Subroutine Agrif_Childbounds
-C     **************************************************************************
-C
-      Subroutine Agrif_Childbounds(nbdim,lboundloc,uboundloc,
-     &                 pttab,petab,pttruetab,cetruetab,memberin)
-C
-CCC   Description:
-CCC   Subroutine calculating the global indices of the child grid
-C
-C
-C     Declarations:
-C
-
-C
-C     Arguments
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(nbdim) :: lboundloc,uboundloc
-      INTEGER,DIMENSION(nbdim) :: pttab,petab,pttruetab,cetruetab
-      LOGICAL :: memberin
-C
-C     Local variables
-      INTEGER :: i,lbglob,ubglob
-C
-#ifdef key_mpp_mpi
-      INTEGER :: indglob1,indglob2
-#endif
-C
-C
-      do i = 1,nbdim
-C
-        lbglob = lboundloc(i)
-        ubglob = uboundloc(i)
-C
-#ifdef key_mpp_mpi
-C
-        Call AGRIF_InvLoc(lbglob,Agrif_ProcRank,i,indglob1)
-C
-        Call AGRIF_InvLoc(ubglob,Agrif_ProcRank,i,indglob2)
-C
-        pttruetab(i) = max(pttab(i),indglob1)        
-C
-        cetruetab(i) = min(petab(i),indglob2)                 
-C
-#else
-C
-        pttruetab(i) = max(pttab(i),lbglob)        
-C
-        cetruetab(i) = min(petab(i),ubglob)
-C
-#endif
-C
-      enddo
-
-      memberin = .TRUE.
-
-      do i=1,nbdim
-        IF (cetruetab(i) < pttruetab(i)) THEN
-          memberin = .FALSE.
-          EXIT
-        ENDIF
-      enddo
-C
-      Return
-C
-C
-      End Subroutine Agrif_Childbounds
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_nbdim_Get_bound
-C     **************************************************************************
-C
-      Subroutine Agrif_nbdim_Get_bound(Variable,
-     &                           lower,upper,indice,nbdim)
-C
-CCC   Description:
-CCC   This subroutine is used to get the lower and the upper boundaries of a
-C     table. Output datas are scalar.
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-C
-      ! we want extract boundaries of this table
-      TYPE(AGRIF_Variable), Pointer :: Variable    
-      INTEGER              :: lower,upper ! output data
-      ! direction in wich we want to know the dimension
-      INTEGER              :: indice      
-      INTEGER              :: nbdim       ! dimension of the table
-C
-C     Local variables
-C
-
-      lower = Variable % lb(indice)
-      upper = Variable % ub(indice)
-      return
-C
-      End Subroutine Agrif_nbdim_Get_bound       
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Get_bound_dimension
-C     **************************************************************************
-C
-      Subroutine Agrif_nbdim_Get_bound_dimension(Variable,
-     &                              lower,upper,nbdim)
-C
-CCC   Description:
-CCC   This subroutine is used to get the lower and the upper boundaries of a
-C        table. Output datas are scalar.
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-C
-      ! we want extract boundaries of this table
-      TYPE(AGRIF_Variable), Pointer     :: Variable    
-      INTEGER                  :: nbdim       ! dimension of the table
-      INTEGER,DIMENSION(nbdim) :: lower,upper ! output data
-C
-C     Local variables       
-C
-      lower = Variable % lb(1:nbdim)
-      upper = Variable % ub(1:nbdim)
-      return
-C
-      End Subroutine Agrif_nbdim_Get_bound_dimension     
-      
-C     **************************************************************************
-CCC   Subroutine Agrif_nbdim_allocation
-C     **************************************************************************
-C
-      Subroutine Agrif_nbdim_allocation(Variable,inf,sup,nbdim)
-C
-CCC   Description:
-CCC   This subroutine is used to Allocate the table Variable
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-C
-      TYPE(AGRIF_Variable), Pointer     :: Variable    
-      INTEGER                  :: nbdim       ! dimension of the table
-      INTEGER,DIMENSION(nbdim) :: inf,sup
-C
-C     Local variables       
-C
-      SELECT CASE (nbdim)
-      CASE (1)
-         allocate(Variable%array1(
-     &            inf(1):sup(1)))
-      CASE (2)
-          allocate(Variable%array2(
-     &            inf(1):sup(1),
-     &            inf(2):sup(2)))
-      CASE (3)
-         allocate(Variable%array3(
-     &            inf(1):sup(1),
-     &            inf(2):sup(2),
-     &            inf(3):sup(3)))
-      CASE (4)
-         allocate(Variable%array4(
-     &            inf(1):sup(1),
-     &            inf(2):sup(2),
-     &            inf(3):sup(3),
-     &            inf(4):sup(4)))
-      CASE (5)
-         allocate(Variable%array5(
-     &            inf(1):sup(1),
-     &            inf(2):sup(2),
-     &            inf(3):sup(3),
-     &            inf(4):sup(4),
-     &            inf(5):sup(5)))
-      CASE (6)
-         allocate(Variable%array6(
-     &            inf(1):sup(1),
-     &            inf(2):sup(2),
-     &            inf(3):sup(3),
-     &            inf(4):sup(4),
-     &            inf(5):sup(5),
-     &            inf(6):sup(6)))
-      END SELECT
-C
-      return
-C
-      End Subroutine Agrif_nbdim_allocation
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_nbdim_deallocation
-C     **************************************************************************
-C
-      Subroutine Agrif_nbdim_deallocation(Variable,nbdim)
-C
-CCC   Description:
-CCC   This subroutine is used to give the same value to the table Variable
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-C
-      TYPE(AGRIF_Variable), Pointer     :: Variable    
-      INTEGER                  :: nbdim       ! dimension of the table
-C
-C     Local variables       
-C
-
-      SELECT CASE (nbdim)
-      CASE (1)
-         Deallocate(Variable%array1)
-      CASE (2)
-         Deallocate(Variable%array2)
-      CASE (3)
-         Deallocate(Variable%array3)
-      CASE (4)
-         Deallocate(Variable%array4)
-      CASE (5)
-         Deallocate(Variable%array5)
-      CASE (6)
-         Deallocate(Variable%array6)
-      END SELECT
-C
-      return
-C
-      End Subroutine Agrif_nbdim_deallocation
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_nbdim_Full_VarEQreal
-C     **************************************************************************
-C
-      Subroutine Agrif_nbdim_Full_VarEQreal(Variable,Value,nbdim)
-C
-CCC   Description:
-CCC   This subroutine is used to get the lower and the upper boundaries of a
-C        table. Output datas are scalar.
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-C
-      TYPE(AGRIF_Variable), Pointer :: Variable    
-      REAL                 :: Value       
-      INTEGER              :: nbdim       ! dimension of the table
-C
-C     Local variables       
-C
-      SELECT CASE (nbdim)
-      CASE (1)
-        Variable%array1 = Value      
-      CASE (2)
-        Variable%array2 = Value
-      CASE (3)
-        Call Agrif_set_tozero3D(Variable%array3)
-!        Variable%array3 = Value
-      CASE (4)
-        Variable%array4 = Value
-      CASE (5)
-        Variable%array5 = Value
-      CASE (6)
-        Variable%array6 = Value
-      END SELECT
-C
-      return
-C
-      End Subroutine Agrif_nbdim_Full_VarEQreal   
-      
-      Subroutine Agrif_set_tozero3D(tab3D)
-      real,dimension(:,:,:),target :: tab3D
-      
-      tab3D = 0.
-      
-      end subroutine agrif_set_tozero3D    
-C
-C
-#if !defined key_mpp_mpi
-C     **************************************************************************
-CCC   Subroutine Agrif_nbdim_VarEQreal
-C     **************************************************************************
-C
-      Subroutine Agrif_nbdim_VarEQreal(Variable,inf,sup,Value,nbdim)
-C
-CCC   Description:
-CCC   This subroutine is used to give the same value to a part of 
-C        the table Variable
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-C
-      TYPE(AGRIF_Variable), Pointer :: Variable    
-      REAL                 :: Value       
-      INTEGER              :: nbdim       ! dimension of the table
-      INTEGER,DIMENSION(nbdim) :: inf,sup
-C
-C     Local variables       
-C
-      SELECT CASE (nbdim)
-      CASE (1)
-         Variable%array1(
-     &             inf(1):sup(1)
-     &             )  = Value
-      CASE (2)
-         Variable%array2(
-     &             inf(1):sup(1),
-     &             inf(2):sup(2)
-     &             )  = Value
-      CASE (3)
-         Variable%array3(
-     &             inf(1):sup(1),
-     &             inf(2):sup(2),
-     &             inf(3):sup(3)
-     &             )  = Value
-      CASE (4)
-         Variable%array4(
-     &             inf(1):sup(1),
-     &             inf(2):sup(2),
-     &             inf(3):sup(3),
-     &             inf(4):sup(4)
-     &             )  = Value
-      CASE (5)
-         Variable%array5(
-     &             inf(1):sup(1),
-     &             inf(2):sup(2),
-     &             inf(3):sup(3),
-     &             inf(4):sup(4),
-     &             inf(5):sup(5)
-     &             )  = Value
-      CASE (6)
-         Variable%array6(
-     &             inf(1):sup(1),
-     &             inf(2):sup(2),
-     &             inf(3):sup(3),
-     &             inf(4):sup(4),
-     &             inf(5):sup(5),
-     &             inf(6):sup(6)
-     &             )  = Value
-      END SELECT
-C
-      return
-C
-      End Subroutine Agrif_nbdim_VarEQreal       
-#endif
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_nbdim_VarEQvar
-C     **************************************************************************
-C
-      Subroutine Agrif_nbdim_VarEQvar(Variable,inf,sup,
-     &                                Variable2,inf2,sup2,
-     &                                nbdim)
-C
-CCC   Description:
-CCC   This subroutine is used to give the value of a part of the table 
-C        Variable2 to the table Variable
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-C
-      TYPE(AGRIF_Variable), Pointer     :: Variable
-      TYPE(AGRIF_Variable), Pointer     :: Variable2
-      INTEGER                  :: nbdim       ! dimension of the table
-      INTEGER,DIMENSION(nbdim) :: inf,sup
-      INTEGER,DIMENSION(nbdim) :: inf2,sup2
-C
-C     Local variables       
-C
-      SELECT CASE (nbdim)
-      CASE (1)
-         Variable%array1(inf(1):sup(1)) = 
-     &         Variable2%array1(inf2(1):sup2(1))
-      CASE (2)
-     
-      Call Agrif_Copy_2d(Variable%array2,Variable2%array2,
-     &  lbound(Variable%array2),
-     &  lbound(Variable2%array2),
-     &  inf,sup,inf2,sup2)
-          
-      CASE (3)
-
-      Call Agrif_Copy_3d(Variable%array3,Variable2%array3,
-     &  lbound(Variable%array3),
-     &  lbound(Variable2%array3),
-     &  inf,sup,inf2,sup2)
-
-      CASE (4)
-      
-      Call Agrif_Copy_4d(Variable%array4,Variable2%array4,
-     &  lbound(Variable%array4),
-     &  lbound(Variable2%array4),
-     &  inf,sup,inf2,sup2)
-     
-      CASE (5)
-        Variable%array5(inf(1):sup(1),
-     &                         inf(2):sup(2), 
-     &                         inf(3):sup(3),
-     &                         inf(4):sup(4), 
-     &                         inf(5):sup(5)) = 
-     &         Variable2%array5(inf2(1):sup2(1),
-     &                          inf2(2):sup2(2),
-     &                          inf2(3):sup2(3),
-     &                          inf2(4):sup2(4),
-     &                          inf2(5):sup2(5))
-      CASE (6)
-        Variable%array6(inf(1):sup(1),
-     &                         inf(2):sup(2),
-     &                         inf(3):sup(3),
-     &                         inf(4):sup(4),
-     &                         inf(5):sup(5),
-     &                         inf(6):sup(6)) = 
-     &         Variable2%array6(inf2(1):sup2(1),
-     &                          inf2(2):sup2(2),
-     &                          inf2(3):sup2(3),
-     &                          inf2(4):sup2(4),
-     &                          inf2(5):sup2(5),
-     &                          inf2(6):sup2(6))
-      END SELECT
-C
-      return
-C
-      End Subroutine Agrif_nbdim_VarEQvar
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_nbdim_Full_VarEQvar
-C     **************************************************************************
-C
-      Subroutine Agrif_nbdim_Full_VarEQvar(Variable,Variable2,
-     &                                nbdim)
-C
-CCC   Description:
-CCC   This subroutine is used to give the value of the table Variable2 
-C        to the table Variable
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-C
-      TYPE(AGRIF_Variable), Pointer     :: Variable
-      TYPE(AGRIF_Variable), Pointer     :: Variable2
-      INTEGER                  :: nbdim       ! dimension of the table
-C
-C     Local variables       
-C
-      SELECT CASE (nbdim)
-      CASE (1)
-          Variable%array1 = Variable2%array1
-      CASE (2)
-          Variable%array2 = Variable2%array2
-      CASE (3)
-          Variable%array3 = Variable2%array3
-      CASE (4)
-          Variable%array4 = Variable2%array4
-      CASE (5)
-          Variable%array5 = Variable2%array5
-      CASE (6)
-          Variable%array6 = Variable2%array6
-      END SELECT
-C
-      return
-C
-      End Subroutine Agrif_nbdim_Full_VarEQvar
-C
-C
-
-C     **************************************************************************
-CCC   Subroutine GiveAgrif_SpecialValueToTab_mpi
-C     **************************************************************************
-C
-      Subroutine GiveAgrif_SpecialValueToTab_mpi(Variable1,Variable2,
-     &                  bound1,lower,upper,Value,nbdim)
-C
-CCC   Description:
-CCC   
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-C
-      TYPE(AGRIF_VARIABLE), Pointer    :: Variable1
-      TYPE(AGRIF_VARIABLE), Pointer    :: Variable2
-      INTEGER                  :: nbdim
-      INTEGER,DIMENSION(:,:,:) :: bound1
-      INTEGER,DIMENSION(nbdim) :: lower,upper
-      REAL                     :: Value
-C
-C     Local variables       
-C
-      SELECT CASE (nbdim)
-      CASE (1)
-             Where (Variable1 % array1(
-     &           bound1(1,1,2):bound1(1,2,2)) 
-     &            == Value)
-             Variable2 % array1(bound1(1,1,1):bound1(1,2,1))
-     &                        = Value
-C      
-              End Where
-      CASE (2)
-             Where (Variable1 % array2(
-     &           bound1(1,1,2):bound1(1,2,2),
-     &           bound1(2,1,2):bound1(2,2,2)) 
-     &            == Value)
-             Variable2 % array2(bound1(1,1,1):bound1(1,2,1),
-     &                       bound1(2,1,1):bound1(2,2,1))
-     &                        = Value
-C      
-              End Where
-      CASE (3)
-             Where (Variable1 % array3(
-     &           bound1(1,1,2):bound1(1,2,2),
-     &                       bound1(2,1,2):bound1(2,2,2),
-     &                       bound1(3,1,2):bound1(3,2,2)) 
-     &            == Value)
-             Variable2 % array3(bound1(1,1,1):bound1(1,2,1),
-     &                       bound1(2,1,1):bound1(2,2,1),
-     &                       bound1(3,1,1):bound1(3,2,1))
-     &                         = Value
-C      
-              End Where
-      CASE (4)
-             Where (Variable1 % array4(
-     &           bound1(1,1,2):bound1(1,2,2),
-     &                       bound1(2,1,2):bound1(2,2,2),
-     &                       bound1(3,1,2):bound1(3,2,2),
-     &                       bound1(4,1,2):bound1(4,2,2)) 
-     &            == Value)
-             Variable2 % array4(bound1(1,1,1):bound1(1,2,1),
-     &                       bound1(2,1,1):bound1(2,2,1),
-     &                       bound1(3,1,1):bound1(3,2,1),
-     &                       bound1(4,1,1):bound1(4,2,1))
-     &                        = Value
-C      
-              End Where
-      CASE (5)
-             Where (Variable1 % array5(
-     &           bound1(1,1,2):bound1(1,2,2),
-     &                       bound1(2,1,2):bound1(2,2,2),
-     &                       bound1(3,1,2):bound1(3,2,2),
-     &                       bound1(4,1,2):bound1(4,2,2),
-     &                       bound1(5,1,2):bound1(5,2,2)) 
-     &            == Value)
-             Variable2 % array5(bound1(1,1,1):bound1(1,2,1),
-     &                       bound1(2,1,1):bound1(2,2,1),
-     &                       bound1(3,1,1):bound1(3,2,1),
-     &                       bound1(4,1,1):bound1(4,2,1),
-     &                       bound1(5,1,1):bound1(5,2,1))
-     &                        = Value
-C      
-              End Where
-      CASE (6)
-             Where (Variable1 % array6(
-     &           bound1(1,1,2):bound1(1,2,2),
-     &                       bound1(2,1,2):bound1(2,2,2),
-     &                       bound1(3,1,2):bound1(3,2,2),
-     &                       bound1(4,1,2):bound1(4,2,2),
-     &                       bound1(5,1,2):bound1(5,2,2),
-     &                       bound1(6,1,2):bound1(6,2,2)) 
-     &            == Value)
-             Variable2 % array6(bound1(1,1,1):bound1(1,2,1),
-     &                       bound1(2,1,1):bound1(2,2,1),
-     &                       bound1(3,1,1):bound1(3,2,1),
-     &                       bound1(4,1,1):bound1(4,2,1),
-     &                       bound1(5,1,1):bound1(5,2,1),
-     &                       bound1(6,1,1):bound1(6,2,1))
-     &                        = Value
-C      
-              End Where
-      END SELECT
-C
-      return
-C
-      End Subroutine GiveAgrif_SpecialValueToTab_mpi    
-
-C     **************************************************************************
-CCC   Subroutine GiveAgrif_SpecialValueToTab
-C     **************************************************************************
-C
-      Subroutine GiveAgrif_SpecialValueToTab(Variable1,Variable2,
-     &                  lower,upper,Value,nbdim)
-C
-CCC   Description:
-CCC   
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-C
-      TYPE(AGRIF_VARIABLE), Pointer    :: Variable1
-      TYPE(AGRIF_VARIABLE), Pointer    :: Variable2
-      INTEGER                  :: nbdim
-      INTEGER,DIMENSION(nbdim) :: lower,upper
-      REAL                     :: Value
-C
-C     Local variables       
-C
-      SELECT CASE (nbdim)
-      CASE (1)
-             Where (Variable1 % array1(
-     &           lower(1):upper(1))
-     &            == Value)
-             Variable2 % array1(lower(1):upper(1))
-     &                        = Value
-C      
-              End Where
-      CASE (2)
-             Where (Variable1 % array2(
-     &           lower(1):upper(1),
-     &           lower(2):upper(2)) 
-     &            == Value)
-             Variable2 % array2(lower(1):upper(1),
-     &                          lower(2):upper(2))
-     &                        = Value
-C      
-              End Where
-      CASE (3)
-             Where (Variable1 % array3(
-     &           lower(1):upper(1),
-     &           lower(2):upper(2), 
-     &           lower(3):upper(3)) 
-     &            == Value)
-             Variable2 % array3(lower(1):upper(1),
-     &                          lower(2):upper(2),
-     &                          lower(3):upper(3))
-     &                         = Value
-C      
-              End Where
-      CASE (4)
-             Where (Variable1 % array4(
-     &           lower(1):upper(1),
-     &           lower(2):upper(2), 
-     &           lower(3):upper(3),
-     &           lower(4):upper(4)) 
-     &            == Value)
-             Variable2 % array4(lower(1):upper(1),
-     &                          lower(2):upper(2),
-     &                          lower(3):upper(3),
-     &                          lower(4):upper(4))
-     &                        = Value
-C      
-              End Where
-      CASE (5)
-             Where (Variable1 % array5(
-     &           lower(1):upper(1),
-     &           lower(2):upper(2),
-     &           lower(3):upper(3),
-     &           lower(4):upper(4),
-     &           lower(5):upper(5)) 
-     &            == Value)
-             Variable2 % array5(lower(1):upper(1),
-     &                          lower(2):upper(2),
-     &                          lower(3):upper(3),
-     &                          lower(4):upper(4),
-     &                          lower(5):upper(5))
-     &                        = Value
-C      
-              End Where
-      CASE (6)
-             Where (Variable1 % array6(
-     &           lower(1):upper(1),
-     &           lower(2):upper(2),
-     &           lower(2):upper(3),
-     &           lower(4):upper(4),
-     &           lower(5):upper(5),
-     &           lower(6):upper(6)) 
-     &            == Value)
-             Variable2 % array6(lower(1):upper(1),
-     &                          lower(2):upper(2),
-     &                          lower(3):upper(3),
-     &                          lower(4):upper(4),
-     &                          lower(5):upper(5),
-     &                          lower(6):upper(6))
-     &                        = Value
-C      
-              End Where
-      END SELECT
-C
-      return
-C
-      End Subroutine GiveAgrif_SpecialValueToTab   
-
-C
-C
-#ifdef key_mpp_mpi
-C     **************************************************************************
-CCC   Subroutine Where_ValTabToTab_mpi
-C     **************************************************************************
-C
-      Subroutine Where_ValTabToTab_mpi(
-     &                  Variable1,Variable2,
-     &                  lower,upper,Value,nbdim)
-C
-CCC   Description:
-CCC   
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-C
-      TYPE(AGRIF_VARIABLE), Pointer     :: Variable1
-      TYPE(AGRIF_VARIABLE), Pointer     :: Variable2
-      INTEGER                  :: nbdim
-      INTEGER,DIMENSION(nbdim) :: lower,upper
-      REAL                     :: Value
-      INTEGER :: i,j,k,l,m,n
-C
-C     Local variables       
-C
-      SELECT CASE (nbdim)
-      CASE (1)
-            DO i = lower(1),upper(1)
-              IF (variable1%array1(i) == Value) then
-                variable1%array1(i)=Variable2%array1(i)
-              ENDIF
-            ENDDO
-      CASE (2)
-            DO j = lower(2),upper(2)
-            DO i = lower(1),upper(1)
-              IF (variable1%array2(i,j) == Value) then
-                variable1%array2(i,j)=Variable2%array2(i,j)
-              ENDIF
-            ENDDO
-            ENDDO
-      CASE (3)
-            DO k = lower(3),upper(3)
-            DO j = lower(2),upper(2)
-            DO i = lower(1),upper(1)
-              IF (variable1%array3(i,j,k) == Value) then
-                variable1%array3(i,j,k)=Variable2%array3(i,j,k)
-              ENDIF
-            ENDDO
-            ENDDO
-            ENDDO
-      CASE (4)
-            DO l = lower(4),upper(4)
-            DO k = lower(3),upper(3)
-            DO j = lower(2),upper(2)
-            DO i = lower(1),upper(1)
-              IF (variable1%array4(i,j,k,l) == Value) then
-                variable1%array4(i,j,k,l)=Variable2%array4(i,j,k,l)
-              ENDIF
-            ENDDO
-            ENDDO
-            ENDDO
-            ENDDO
-      CASE (5)
-            DO m = lower(5),upper(5)
-            DO l = lower(4),upper(4)
-            DO k = lower(3),upper(3)
-            DO j = lower(2),upper(2)
-            DO i = lower(1),upper(1)
-              IF (variable1%array5(i,j,k,l,m) == Value) then
-              variable1%array5(i,j,k,l,m)=Variable2%array5(i,j,k,l,m)
-              ENDIF
-            ENDDO
-            ENDDO
-            ENDDO
-            ENDDO
-            ENDDO
-      CASE (6)
-            DO n = lower(6),upper(6)
-            DO m = lower(5),upper(5)
-            DO l = lower(4),upper(4)
-            DO k = lower(3),upper(3)
-            DO j = lower(2),upper(2)
-            DO i = lower(1),upper(1)
-              IF (variable1%array6(i,j,k,l,m,n) == Value) then
-            variable1%array6(i,j,k,l,m,n)=Variable2%array6(i,j,k,l,m,n)
-              ENDIF
-            ENDDO
-            ENDDO
-            ENDDO
-            ENDDO
-            ENDDO
-            ENDDO
-      END SELECT
-C
-      return
-C
-      End Subroutine Where_ValTabToTab_mpi    
-#endif
-
-C     **************************************************************************
-CCC   Subroutine PreProcessToInterpOrUpdate
-C     **************************************************************************
-C
-      Subroutine PreProcessToInterpOrUpdate(parent,child,
-     &             petab_Child,
-     &             pttab_Child,pttab_Parent,
-     &             s_Child,s_Parent,
-     &             ds_Child,ds_Parent,
-     &             nbdim)
-C
-CCC   Description:
-CCC   
-C
-C     Declarations:
-C      
-C     arguments                                   
-      TYPE(AGRIF_PVariable) :: parent   ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child    ! Variable on the child grid
-      INTEGER :: nbdim                  
-      INTEGER,DIMENSION(6) :: pttab_child  
-      INTEGER,DIMENSION(6) :: petab_child      
-      INTEGER,DIMENSION(6) :: pttab_parent  
-      TYPE(AGRIF_Variable), Pointer :: root ! Pointer on the variable of the 
-                                            ! root grid
-      TYPE(Agrif_Grid), Pointer :: Agrif_Child_Gr,Agrif_Parent_Gr
-      REAL, DIMENSION(6) :: s_child,s_parent
-      REAL, DIMENSION(6) :: ds_child,ds_parent
-C     locals variables
-      INTEGER :: n
-      
-C
-C     Arguments      
-C
-
-C
-C     Local variables       
-C
-      Agrif_Child_Gr => Agrif_Curgrid
-      Agrif_Parent_Gr => Agrif_Curgrid % parent
-C
-      root => child % var % root_var 
-C
-C     Number of dimensions of the current grid
-      nbdim = root % nbdim
-C      
-      do n=1,nbdim
-C            
-        Select case(root % interptab(n))
-C
-C       Value of interptab(n) can be either x,y,z or N for a no space 
-C       DIMENSION            
-C
-C         The DIMENSION is 'x'
-          case('x')
-C
-            pttab_Child(n) = root % point(1)
-C            
-            pttab_Parent(n) = root % point(1)
-C        
-            s_Child(n) = Agrif_Child_Gr % Agrif_x(1)
-C
-            s_Parent(n) = Agrif_Parent_Gr % Agrif_x(1)
-C        
-            ds_Child(n) = Agrif_Child_Gr % Agrif_d(1)
-C
-            ds_Parent(n) = Agrif_Parent_Gr % Agrif_d(1)
-C                      
-            if (root % posvar(n).EQ.1) then
-C          
-              petab_Child(n) = pttab_Child(n) + Agrif_Child_Gr%nb(1)
-C        
-              else
-C          
-                petab_Child(n) = pttab_Child(n) + 
-     &                              Agrif_Child_Gr%nb(1) - 1
-C          
-                s_Child(n) = s_Child(n) + ds_Child(n)/2.
-C
-                s_Parent(n) = s_Parent(n) + ds_Parent(n)/2.
-C        
-            endif                  
-C
-C         The DIMENSION is 'y'
-          case('y')
-C
-            pttab_Child(n) = root % point(2)
-C            
-            pttab_Parent(n) = root % point(2)
-C        
-            s_Child(n) = Agrif_Child_Gr % Agrif_x(2)
-C
-            s_Parent(n) = Agrif_Parent_Gr % Agrif_x(2) 
-C        
-            ds_Child(n) = Agrif_Child_Gr % Agrif_d(2)
-C
-            ds_Parent(n) = Agrif_Parent_Gr % Agrif_d(2)
-C                      
-            if (root % posvar(n).EQ.1) then
-C          
-             petab_Child(n) = pttab_Child(n) + Agrif_Child_Gr%nb(2)
-C          
-              else
-C          
-                petab_Child(n) = pttab_Child(n) + 
-     &                       Agrif_Child_Gr%nb(2) - 1
-C          
-                s_Child(n) = s_Child(n) + ds_Child(n)/2.
-C
-                s_Parent(n) = s_Parent(n) + ds_Parent(n)/2.
-C        
-            endif
-            
-C
-C         The DIMENSION is 'z'                            
-          case('z')
-C
-            pttab_Child(n) = root % point(3)
-C            
-            pttab_Parent(n) = root % point(3)
-C        
-            s_Child(n) = Agrif_Child_Gr % Agrif_x(3)
-C
-            s_Parent(n) = Agrif_Parent_Gr % Agrif_x(3)
-C        
-            ds_Child(n) = Agrif_Child_Gr % Agrif_d(3)
-C
-            ds_Parent(n) = Agrif_Parent_Gr % Agrif_d(3)
-C                      
-            if (root % posvar(n).EQ.1) then
-C          
-             petab_Child(n) = pttab_Child(n) + Agrif_Child_Gr%nb(3)
-C          
-              else
-C          
-                petab_Child(n) = pttab_Child(n) + 
-     &                      Agrif_Child_Gr%nb(3) - 1
-C
-                s_Child(n) = s_Child(n) + ds_Child(n)/2.
-C
-                s_Parent(n) = s_Parent(n) + ds_Parent(n)/2.
-C        
-            endif       
-C 
-C         The DIMENSION is not space                            
-          case('N')
-C
-C         The next coefficients are calculated in order to do a simple copy of 
-C         values of the grid variable when the procedure of interpolation is 
-C         called for this DIMENSION 
-C      
-            Call Agrif_nbdim_Get_bound(child % var,
-     &                           pttab_Child(n),petab_Child(n),n,nbdim)
-C
-C           No interpolation but only a copy of the values of the grid variable
-C
-            pttab_Parent(n) = pttab_Child(n)
-C              
-            s_Child(n)=0.
-C      
-            s_Parent(n)=0. 
-C      
-            ds_Child(n)=1.
-C      
-            ds_Parent(n)=1.
-C
-        End select
-C            
-      enddo     
-C
-      return
-C
-      End Subroutine PreProcessToInterpOrUpdate     
-
-#ifdef key_mpp_mpi
-C
-C     **************************************************************************
-CCC   Subroutine GetLocalBoundaries
-C     **************************************************************************
-C
-      Subroutine GetLocalBoundaries(tab1,tab2,i,lb,ub,deb,fin)
-C
-CCC   Descritpion:
-C 
-C
-C     Declarations:
-C
-
-C
-C
-C     Scalar arguments
-      INTEGER  ::  tab1,tab2
-      INTEGER  ::  i
-      INTEGER  ::  lb,ub
-      INTEGER  ::  deb,fin
-C
-C     Local scalars
-      INTEGER  ::  imin,imax
-      INTEGER  ::  i1,i2
-C
-C
-      Call AGRIF_InvLoc(lb,AGRIF_ProcRank,i,imin)
-C
-      Call AGRIF_InvLoc(ub,AGRIF_ProcRank,i,imax)
-C
-C
-      if (imin > tab2) then
-C
-          i1 = imax - imin
-C
-        else
-C
-          i1 = max(tab1 - imin,0)
-C
-      endif
-C
-      if (imax < tab1) then
-C
-          i2 = -(imax - imin)
-C
-        else
-C
-          i2 = min(tab2 - imax,0)
-C
-      endif
-C
-      deb = lb + i1
-C
-      fin = ub + i2
-C
-C
-      End Subroutine GetLocalBoundaries
-C
-#endif
-C
-C
-#ifdef key_mpp_mpi
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_GlobtoLocInd2
-C     **************************************************************************
-C
-      Subroutine Agrif_GlobtoLocInd2(tabarray,lboundl,uboundl,tab1,tab2,
-     &                              nbdim,rank,member)
-C
-CCC   Description:
-CCC   For a global index located on the current processor, tabarray gives the 
-CCC   corresponding local index   
-C
-C
-C     Declarations:
-C
-
-C
-C     Arguments
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(nbdim) :: tab1,tab2
-      INTEGER,DIMENSION(nbdim,2,2 ) :: tabarray
-      INTEGER,DIMENSION(nbdim) :: lboundl,uboundl
-      INTEGER :: rank
-      LOGICAL :: member
-C    
-C     Local variables
-      INTEGER :: i,i1,k
-      INTEGER :: nbloc(nbdim)
-C
-C
-      tabarray(:,1,:) =  HUGE(1)
-      tabarray(:,2,:) =  -HUGE(1)
-
-      nbloc = 0
-C        
-      do i = 1,nbdim
-C       
-        Call Agrif_Invloc(lboundl(i),rank,i,i1)
-        
-        do k=tab1(i)+lboundl(i)-i1,tab2(i)+lboundl(i)-i1
-          IF ((k .GE. lboundl(i)) .AND. (k.LE.uboundl(i))) THEN
-            nbloc(i) = 1
-            tabarray(i,1,1) = min(tabarray(i,1,1),k-lboundl(i)+i1)
-            tabarray(i,2,1) = max(tabarray(i,2,1),k-lboundl(i)+i1)
-        
-            tabarray(i,1,2) = min(tabarray(i,1,2),k)
-            tabarray(i,2,2) = max(tabarray(i,2,2),k)
-          ENDIF
-        enddo
-C
-      enddo
-
-      member = .FALSE.
-      IF (sum(nbloc) == nbdim) member = .TRUE.
-C
-      Return
-C
-C
-      End Subroutine Agrif_GlobtoLocInd2
-C
-#endif      
-
-      Subroutine Agrif_Copy_2d(tabout,tabin,l,m,inf,sup,inf2,sup2)
-      integer,dimension(2) :: l,m,inf,sup,inf2,sup2
-      real,target,dimension(l(1):,l(2):) :: tabout
-      real,target,dimension(m(1):,m(2):) :: tabin
-          tabout(inf(1):sup(1),
-     &                         inf(2):sup(2)) = 
-     &         tabin(inf2(1):sup2(1),
-     &                          inf2(2):sup2(2))
-      End Subroutine Agrif_Copy_2d
-      
-      Subroutine Agrif_Copy_3d(tabout,tabin,l,m,inf,sup,inf2,sup2)
-      integer,dimension(3) :: l,m,inf,sup,inf2,sup2
-      real,target,dimension(l(1):,l(2):,l(3):) :: tabout
-      real,target,dimension(m(1):,m(2):,m(3):) :: tabin
-          tabout(inf(1):sup(1),
-     &                         inf(2):sup(2), 
-     &                         inf(3):sup(3)) = 
-     &         tabin(inf2(1):sup2(1),
-     &                          inf2(2):sup2(2),
-     &                          inf2(3):sup2(3))
-      End Subroutine Agrif_Copy_3d
-      
-      Subroutine Agrif_Copy_4d(tabout,tabin,l,m,inf,sup,inf2,sup2)
-      integer,dimension(4) :: l,m,inf,sup,inf2,sup2
-      real,target,dimension(l(1):,l(2):,l(3):,l(4):) :: tabout
-      real,target,dimension(m(1):,m(2):,m(3):,m(4):) :: tabin
-          tabout(inf(1):sup(1),
-     &                         inf(2):sup(2), 
-     &                         inf(3):sup(3), 
-     &                         inf(4):sup(4)) = 
-     &         tabin(inf2(1):sup2(1),
-     &                          inf2(2):sup2(2),
-     &                          inf2(3):sup2(3),
-     &                          inf2(4):sup2(4))
-      End Subroutine Agrif_Copy_4d      
-
-      End Module Agrif_Arrays
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F90	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F90	(revision 6440)
@@ -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: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F	(revision 6439)
+++ 	(revision )
@@ -1,1337 +1,0 @@
-!
-! $Id: modbc.F 2731 2011-04-08 12:05:35Z rblod $
-!
-C     AGRIF (Adaptive Grid Refinement In Fortran)
-C
-C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
-C
-C     This program is free software; you can redistribute it and/or modify
-C     it under the terms of the GNU General Public License as published by
-C     the Free Software Foundation; either version 2 of the License, or
-C     (at your option) any later version.
-C
-C     This program is distributed in the hope that it will be useful,
-C     but WITHOUT ANY WARRANTY; without even the implied warranty of
-C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-C     GNU General Public License for more details.
-C
-C     You should have received a copy of the GNU General Public License
-C     along with this program; if not, write to the Free Software
-C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
-C
-C
-C
-CCC   Module Agrif_Boundary 
-C 
-      Module Agrif_Boundary  
-C
-CCC   Description:
-CCC   Module to calculate the boundary conditions on the child grids from their
-CCC   parent grids.
-C
-C     Modules used:  
-C   
-      Use Agrif_Interpolation        
-C
-      IMPLICIT NONE
-C        
-      CONTAINS   
-C     Define procedures contained in this module
-C
-C
-      
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_bc_1d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_bc_1d(TypeInterp,parent,child,tab,deb,fin,
-     &                              weight,pweight,procname)
-C
-CCC   Description:
-CCC   Subroutine to calculate the boundary conditions on a fine grid for a 1D 
-CCC   grid variable.
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-      External :: procname
-      Optional :: procname
-      INTEGER,DIMENSION(6,6) :: TypeInterp    ! TYPE of interpolation (linear, 
-                                            ! lagrange, spline, ... )
-      TYPE(AGRIF_PVariable) :: parent       ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child        ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp    ! Temporary variable on the child 
-                                            ! grid
-      INTEGER :: deb,fin                    ! Positions where interpolations are
-                                            ! done on the fine grid 
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1) 
-     &    ), Target :: tab ! Values of the grid variable
-      LOGICAL :: pweight                    ! Indicates if weight is used for  
-                                            ! the temporal interpolation 
-      REAL :: weight                        ! Coefficient for the time 
-                                            ! interpolation
-C
-C
-C     Definition of a temporary AGRIF_PVariable data TYPE representing the grid
-C     variable.   
-C
-      allocate(childtemp % var)  
-C
-      childtemp % var % root_var => child % var % root_var
-C      
-C     Values of the grid variable
-      childtemp % var % parray1 => tab  
-C
-C     Temporary results for the time interpolation before and after the space 
-C     interpolation 
-      childtemp % var % oldvalues2D => child % var % oldvalues2D
-C 
-C     Index indicating if a space interpolation is necessary
-      childtemp % var % interpIndex => child % var % interpIndex       
-      childtemp % var % Interpolationshouldbemade = 
-     &                 child % var % Interpolationshouldbemade   
-      childtemp % var % list_interp => child % var% list_interp 
-      
-      childtemp % var% lb = child % var % lb
-      childtemp % var% ub = child % var % ub         
-C
-C     Call to the procedure for the calculations of the boundary conditions
-      IF (present(procname)) THEN
-      Call Agrif_CorrectVariable
-     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight,procname)
-      ELSE
-      Call Agrif_CorrectVariable
-     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight)
-      ENDIF
-
-C   
-      child % var % oldvalues2D => childtemp % var % oldvalues2D
-      child % var % list_interp => childtemp % var %list_interp
-C         
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Interp_bc_1D
-C
-      
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_bc_2d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_bc_2d(TypeInterp,parent,child,tab,deb,fin,
-     &                              weight,pweight,procname)
-C
-CCC   Description:
-CCC   Subroutine to calculate the boundary conditions on a fine grid for a 2D 
-CCC   grid variable.
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-      External :: procname
-      Optional :: procname
-      INTEGER,DIMENSION(6,6) :: TypeInterp    ! TYPE of interpolation (linear, 
-                                            ! lagrange, spline, ... )
-      TYPE(AGRIF_PVariable) :: parent       ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child        ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp    ! Temporary variable on the child 
-                                            ! grid
-      INTEGER :: deb,fin                    ! Positions where interpolations are
-                                            ! done on the fine grid 
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1),
-     &         child%var%lb(2):child%var%ub(2) 
-     &    ), Target :: tab ! Values of the grid variable
-      LOGICAL :: pweight                    ! Indicates if weight is used for  
-                                            ! the temporal interpolation 
-      REAL :: weight                        ! Coefficient for the time 
-                                            ! interpolation
-C
-C
-C     Definition of a temporary AGRIF_PVariable data TYPE representing the grid
-C     variable.   
-C
-      allocate(childtemp % var)  
-C
-      childtemp % var % root_var => child % var % root_var
-C      
-C     Values of the grid variable
-      childtemp % var % parray2 => tab  
-C
-C     Temporary results for the time interpolation before and after the space 
-C     interpolation 
-      childtemp % var % oldvalues2D => child % var % oldvalues2D
-C 
-C     Index indicating if a space interpolation is necessary
-      childtemp % var % interpIndex => child % var % interpIndex       
-      childtemp % var % Interpolationshouldbemade = 
-     &                 child % var % Interpolationshouldbemade   
-      childtemp % var % list_interp => child % var% list_interp 
-      
-      childtemp % var% lb = child % var % lb
-      childtemp % var% ub = child % var % ub         
-C
-C     Call to the procedure for the calculations of the boundary conditions
-      IF (present(procname)) THEN
-      Call Agrif_CorrectVariable
-     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight,procname)
-      ELSE
-      Call Agrif_CorrectVariable
-     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight)
-      ENDIF
-
-C   
-      child % var % oldvalues2D => childtemp % var % oldvalues2D
-      child % var % list_interp => childtemp % var %list_interp
-C         
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Interp_bc_2D
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_bc_3d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_bc_3d(TypeInterp,parent,child,tab,deb,fin,
-     &                              weight,pweight,procname)            
-C
-CCC   Description:
-CCC   Subroutine to calculate the boundary conditions on a fine grid for a 3D 
-CCC   variable.
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments 
-      External :: procname
-      Optional :: procname     
-      INTEGER,DIMENSION(6,6) :: TypeInterp    ! TYPE of interpolation (linear, 
-                                            ! lagrange, spline, ... )
-      TYPE(AGRIF_PVariable) :: parent       ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child        ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp    ! Temporary variable on the child
-                                            ! grid
-      INTEGER :: deb,fin                    ! Positions where interpolations 
-                                            ! are done on the fine grid 
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1),
-     &         child%var%lb(2):child%var%ub(2),
-     &         child%var%lb(3):child%var%ub(3)
-     &         ), Target :: tab ! Values of the grid variable
-      LOGICAL :: pweight                    ! Indicates if weight is used for 
-                                            ! the temporal interpolation 
-      REAL :: weight                        ! Coefficient for the time 
-                                            ! interpolation
-C
-C
-C     Definition of a temporary AGRIF_PVariable data TYPE representing the grid 
-C     variable.  
-C
-      allocate(childtemp % var)  
-C
-      childtemp % var % root_var => child % var % root_var       
-C      
-C     Values of the grid variable
-      childtemp % var % parray3 => tab
-C
-C     Temporary results for the time interpolation before and after the space 
-C     interpolation  
-      childtemp % var % oldvalues2D => child % var % oldvalues2D
-C 
-C     Index indicating if a space interpolation is necessary
-      childtemp % var % interpIndex => child % var % interpIndex
-      childtemp % var % Interpolationshouldbemade = 
-     &                 child % var % Interpolationshouldbemade 
-      childtemp % var % list_interp => child % var% list_interp 
-      
-      childtemp % var% lb = child % var % lb
-      childtemp % var% ub = child % var % ub
-C
-C     Call to the procedure for the calculations of the boundary conditions     
-      IF (present(procname)) THEN
-      Call Agrif_CorrectVariable
-     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight,procname)
-      ELSE
-      Call Agrif_CorrectVariable
-     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight)
-      ENDIF
-C
-      child % var % oldvalues2D => childtemp % var % oldvalues2D
-      child % var % list_interp => childtemp % var %list_interp      
-C      
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Interp_bc_3D               
-C
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_bc_4d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_bc_4d(TypeInterp,parent,child,tab,deb,fin,
-     &                             weight,pweight,procname)            
-C
-CCC   Description:
-CCC   Subroutine to calculate the boundary conditions on a fine grid for a 4D 
-CCC   grid variable.
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-      External :: procname
-      Optional :: procname     
-      INTEGER,DIMENSION(6,6) :: TypeInterp      ! TYPE of interpolation (linear, 
-                                              ! lagrange, spline, ... )
-      TYPE(AGRIF_PVariable) :: parent         ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child          ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp      ! Temporary varaiable on the child
-                                              ! grid
-      INTEGER :: deb,fin                      ! Positions where interpolations 
-                                              ! are done on the fine grid 
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1),
-     &         child%var%lb(2):child%var%ub(2),
-     &         child%var%lb(3):child%var%ub(3),
-     &         child%var%lb(4):child%var%ub(4)
-     &        ), Target :: tab ! Values of the grid variable
-      LOGICAL :: pweight                      ! Indicates if weight is used for 
-                                              ! the temporal interpolation 
-      REAL :: weight                          ! Coefficient for the time 
-                                              ! interpolation
-C
-C
-C     Definition of a temporary AGRIF_PVariable data TYPE representing the grid 
-C     variable.  
-C
-      allocate(childtemp % var)  
-C
-      childtemp % var % root_var => child % var % root_var 
-C      
-C     Values of the grid variable
-      childtemp % var % parray4 => tab  
-C
-C     Temporary results for the time interpolation before and after the space 
-C     interpolation       
-      childtemp % var % oldvalues2D => child % var % oldvalues2D
-C 
-C     Index indicating if a space interpolation is necessary
-      childtemp % var % interpIndex => child % var % interpIndex       
-      childtemp % var % Interpolationshouldbemade = 
-     &                 child % var % Interpolationshouldbemade  
-      childtemp % var % list_interp => child % var% list_interp 
-      
-      childtemp % var% lb = child % var % lb
-      childtemp % var% ub = child % var % ub               
-C
-C     Call to the procedure for the calculations of the boundary conditions
-      IF (present(procname)) THEN
-      Call Agrif_CorrectVariable
-     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight,procname)
-      ELSE
-      Call Agrif_CorrectVariable
-     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight)
-      ENDIF
-C
-      child % var % oldvalues2D => childtemp % var % oldvalues2D
-      child % var % list_interp => childtemp % var %list_interp      
-C      
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Interp_bc_4D
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_bc_5d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_bc_5d(TypeInterp,parent,child,tab,deb,fin,
-     &                             weight,pweight,procname)            
-C
-CCC   Description:
-CCC   Subroutine to calculate the boundary conditions on a fine grid for a 5D 
-CCC   grid variable.
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-      External :: procname
-      Optional :: procname     
-      INTEGER,DIMENSION(6,6) :: TypeInterp      ! TYPE of interpolation (linear, 
-                                              ! lagrange, spline, ... )
-      TYPE(AGRIF_PVariable) :: parent         ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child          ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp      ! Temporary varaiable on the child
-                                              ! grid
-      INTEGER :: deb,fin                      ! Positions where interpolations 
-                                              ! are done on the fine grid 
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1),
-     &         child%var%lb(2):child%var%ub(2),
-     &         child%var%lb(3):child%var%ub(3),
-     &         child%var%lb(4):child%var%ub(4),
-     &         child%var%lb(5):child%var%ub(5)
-     &         ), Target :: tab ! Values of the grid variable
-      LOGICAL :: pweight                      ! Indicates if weight is used for 
-                                              ! the temporal interpolation 
-      REAL :: weight                          ! Coefficient for the time 
-                                              ! interpolation
-C
-C
-C     Definition of a temporary AGRIF_PVariable data TYPE representing the grid 
-C     variable.  
-C
-      allocate(childtemp % var)  
-C
-      childtemp % var % root_var => child % var % root_var 
-C      
-C     Values of the grid variable
-      childtemp % var % parray5 => tab  
-C
-C     Temporary results for the time interpolation before and after the space 
-C     interpolation       
-      childtemp % var % oldvalues2D => child % var % oldvalues2D
-C 
-C     Index indicating if a space interpolation is necessary
-      childtemp % var % interpIndex => child % var % interpIndex       
-      childtemp % var % Interpolationshouldbemade = 
-     &                 child % var % Interpolationshouldbemade 
-      childtemp % var % list_interp => child % var% list_interp  
-      
-      childtemp % var% lb = child % var % lb
-      childtemp % var% ub = child % var % ub
-                     
-C
-C     Call to the procedure for the calculations of the boundary conditions  
-      IF (present(procname)) THEN
-      Call Agrif_CorrectVariable
-     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight,procname)
-      ELSE
-      Call Agrif_CorrectVariable
-     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight)
-      ENDIF
-C
-      child % var % oldvalues2D => childtemp % var % oldvalues2D
-      child % var % list_interp => childtemp % var %list_interp      
-C      
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Interp_bc_5D
-C
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_bc_6d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_bc_6d(TypeInterp,parent,child,tab,deb,fin,
-     &                             weight,pweight)            
-C
-CCC   Description:
-CCC   Subroutine to calculate the boundary conditions on a fine grid for a 6D 
-CCC   grid variable.
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-      INTEGER,DIMENSION(6,6) :: TypeInterp      ! TYPE of interpolation (linear, 
-                                              ! lagrange, spline, ... )
-      TYPE(AGRIF_PVariable) :: parent         ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child          ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp      ! Temporary varaiable on the child
-                                              ! grid
-      INTEGER :: deb,fin                      ! Positions where interpolations 
-                                              ! are done on the fine grid 
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1),
-     &         child%var%lb(2):child%var%ub(2),
-     &         child%var%lb(3):child%var%ub(3),
-     &         child%var%lb(4):child%var%ub(4),
-     &         child%var%lb(5):child%var%ub(5),
-     &         child%var%lb(6):child%var%ub(6)
-     &         ), Target :: tab ! Values of the grid variable
-      LOGICAL :: pweight                      ! Indicates if weight is used for 
-                                              ! the temporal interpolation 
-      REAL :: weight                          ! Coefficient for the time 
-                                              ! interpolation
-C
-C
-C     Definition of a temporary AGRIF_PVariable data TYPE representing the grid 
-C     variable.  
-C
-      allocate(childtemp % var)  
-C
-      childtemp % var % root_var => child % var % root_var 
-C      
-C     Values of the grid variable
-      childtemp % var % parray6 => tab  
-C
-C     Temporary results for the time interpolation before and after the space 
-C     interpolation       
-      childtemp % var % oldvalues2D => child % var % oldvalues2D
-C 
-C     Index indicating if a space interpolation is necessary
-      childtemp % var % interpIndex => child % var % interpIndex       
-      childtemp % var % Interpolationshouldbemade = 
-     &                 child % var % Interpolationshouldbemade 
-      childtemp % var % list_interp => child % var% list_interp  
-      
-      childtemp % var% lb = child % var % lb
-      childtemp % var% ub = child % var % ub               
-C
-C     Call to the procedure for the calculations of the boundary conditions
-      Call Agrif_CorrectVariable
-     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight)
-C
-      child % var % oldvalues2D => childtemp % var % oldvalues2D
-      child % var % list_interp => childtemp % var %list_interp      
-C      
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Interp_bc_6D
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_CorrectVariable
-C     **************************************************************************
-C
-      Subroutine AGRIF_CorrectVariable(TypeInterp,parent,child,deb,fin,
-     &                                 pweight,weight,procname)
-C
-CCC   Description:
-CCC   Subroutine to calculate the boundary conditions on a fine grid.
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments
-      External :: procname
-      Optional :: procname
-      TYPE(AGRIF_PVariable) :: parent         ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child          ! Variable on the child grid
-      INTEGER,DIMENSION(6,6)  :: TypeInterp     ! TYPE of interpolation
-                                              !    (linear,lagrange,...)
-      INTEGER               :: deb,fin        ! Positions where boundary
-                                              !    conditions are calculated
-      LOGICAL               :: pweight        ! Indicates if weight is used 
-                                              !    for the time interpolation 
-      REAL                  :: weight         ! Coefficient for the time
-                                              !    interpolation
-C
-C     Local scalars
-      TYPE(Agrif_Grid)    , Pointer :: Agrif_Child_Gr,Agrif_Parent_Gr
-      TYPE(AGRIF_Variable), Pointer :: root   ! Variable on the root grid
-      INTEGER                       :: nbdim  ! Number of dimensions of 
-                                              !    the grid variable 
-      INTEGER                       :: n
-      INTEGER,DIMENSION(6)          :: pttab_child  ! Index of the first point
-                                                    !    inside the domain for
-                                                    !    the child grid variable
-      INTEGER,DIMENSION(6)          :: pttab_parent ! Index of the first point
-                                                    !    inside the domain for
-                                                    !    the parent grid
-                                                    !    variable
-      INTEGER,DIMENSION(6)          :: nbtab_Child  ! Number of the cells
-      INTEGER,DIMENSION(6)          :: posvartab_Child    ! Position of the
-                                                    !    variable on the cell 
-      INTEGER,DIMENSION(6)          :: loctab_Child ! Indicates if the child
-                                                    !    grid has a common
-                                                    !    border with the root
-                                                    !    grid      
-      REAL, DIMENSION(6)            :: s_child,s_parent   ! Positions of the
-                                                    !    parent and child grids
-      REAL, DIMENSION(6)            :: ds_child,ds_parent ! Space steps of the
-                                                    !    parent and child grids 
-C
-C
-      loctab_child(:) = 0
-C
-      Agrif_Child_Gr => Agrif_Curgrid
-      Agrif_Parent_Gr => Agrif_Curgrid % parent
-      root => child % var % root_var 
-      nbdim = root % nbdim
-C
-      do n = 1,nbdim
-        posvartab_child(n) = root % posvar(n)      
-      enddo
-C
-C
-      do n = 1,nbdim
-C
-        Select case(root % interptab(n))
-C
-          case('x') ! x DIMENSION
-C
-            nbtab_Child(n) = Agrif_Child_Gr % nb(1)
-            pttab_Child(n) = root % point(1)
-            pttab_Parent(n) = root % point(1)
-            s_Child(n) = Agrif_Child_Gr % Agrif_x(1)
-            s_Parent(n) = Agrif_Parent_Gr % Agrif_x(1)
-            ds_Child(n) = Agrif_Child_Gr % Agrif_d(1)
-            ds_Parent(n) = Agrif_Parent_Gr % Agrif_d(1)
-            if (root % posvar(n) == 2) then
-                s_Child(n) = s_Child(n) + ds_Child(n)/2.
-                s_Parent(n) = s_Parent(n) + ds_Parent(n)/2.
-            endif
-C
-            if (Agrif_CURGRID % NearRootBorder(1)) 
-     &         loctab_child(n) = -1
-            if (Agrif_CURGRID % DistantRootBorder(1))
-     &         loctab_child(n) = -2
-            if ((Agrif_CURGRID % NearRootBorder(1)) .AND. 
-     &          (Agrif_CURGRID % DistantRootBorder(1))) 
-     &         loctab_child(n) = -3
-C
-          case('y') ! y DIMENSION      
-C
-            nbtab_Child(n) = Agrif_Child_Gr % nb(2)
-            pttab_Child(n) = root % point(2)
-            pttab_Parent(n) = root % point(2)
-            s_Child(n) = Agrif_Child_Gr % Agrif_x(2)
-            s_Parent(n) = Agrif_Parent_Gr % Agrif_x(2) 
-            ds_Child(n) = Agrif_Child_Gr % Agrif_d(2)
-            ds_Parent(n) = Agrif_Parent_Gr % Agrif_d(2)
-            if (root % posvar(n) == 2) then        
-                s_Child(n) = s_Child(n) + ds_Child(n)/2.
-                s_Parent(n) = s_Parent(n) + ds_Parent(n)/2.
-            endif        
-C
-            if (Agrif_CURGRID % NearRootBorder(2)) 
-     &         loctab_child(n) = -1
-            if (Agrif_CURGRID % DistantRootBorder(2)) 
-     &         loctab_child(n) = -2
-            if ((Agrif_CURGRID % NearRootBorder(2)) .AND. 
-     &          (Agrif_CURGRID % DistantRootBorder(2))) 
-     &         loctab_child(n) = -3
-C
-          case('z') ! z DIMENSION
-C
-            nbtab_Child(n) = Agrif_Child_Gr % nb(3)
-            pttab_Child(n) = root % point(3)
-            pttab_Parent(n) = root % point(3)
-            s_Child(n) = Agrif_Child_Gr % Agrif_x(3)
-            s_Parent(n) = Agrif_Parent_Gr % Agrif_x(3)
-            ds_Child(n) = Agrif_Child_Gr % Agrif_d(3)
-            ds_Parent(n) = Agrif_Parent_Gr % Agrif_d(3)
-            if (root % posvar(n) == 2) then        
-                s_Child(n) = s_Child(n) + ds_Child(n)/2.
-                s_Parent(n) = s_Parent(n) + ds_Parent(n)/2.
-            endif        
-C
-            if (Agrif_CURGRID % NearRootBorder(3)) 
-     &         loctab_child(n) = -1
-            if (Agrif_CURGRID % DistantRootBorder(3)) 
-     &         loctab_child(n) = -2
-            if ((Agrif_CURGRID % NearRootBorder(3)) .AND. 
-     &          (Agrif_CURGRID % DistantRootBorder(3))) 
-     &         loctab_child(n) = -3
-C
-          case('N') ! No space DIMENSION      
-C
-            nbtab_Child(n) = child % var % ub(n) - child % var % lb(n)
-            pttab_Child(n) = child % var % lb(n)
-C
-C           No interpolation but only a copy of the values of the grid variable
-C      
-            posvartab_child(n) = 1
-            pttab_Parent(n)= pttab_Child(n)
-            s_Child(n)=0.
-            s_Parent(n)=0. 
-            ds_Child(n)=1.
-            ds_Parent(n)=1.
-            loctab_child(n) = -3
-C
-        End select
-C
-      enddo
-C
-         IF (present(procname)) THEN
-          Call AGRIF_CorrectnD
-     &         (TypeInterp,parent,child,deb,fin,pweight,weight,
-     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
-     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
-     &          loctab_Child(1:nbdim),
-     &          s_Child(1:nbdim),s_Parent(1:nbdim),
-     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim,procname)
-        ELSE
-          Call AGRIF_CorrectnD
-     &         (TypeInterp,parent,child,deb,fin,pweight,weight,
-     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
-     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
-     &          loctab_Child(1:nbdim),
-     &          s_Child(1:nbdim),s_Parent(1:nbdim),
-     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim)
-         ENDIF
-C
-C
-      End subroutine AGRIF_CorrectVariable
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Correctnd
-C     **************************************************************************
-C
-      Subroutine AGRIF_Correctnd(TypeInterp,parent,child,deb,fin,
-     &                           pweight,weight,
-     &                           pttab_child,pttab_Parent,
-     &                           nbtab_Child,posvartab_Child,
-     &                           loctab_Child,
-     &                           s_Child,s_Parent,
-     &                           ds_Child,ds_Parent,nbdim,procname)
-C
-CCC   Description:
-CCC   Subroutine to calculate the boundary conditions for a nD grid variable on 
-CCC   a fine grid by using a space and time interpolations; it is called by the 
-CCC   Agrif_CorrectVariable procedure.
-C
-C
-C     Declarations:
-C
-      
-C
-#ifdef key_mpp_mpi
-C
-      INCLUDE 'mpif.h'
-C
-#endif
-C
-C     Arguments
-      External :: procname
-      Optional :: procname
-      INTEGER,DIMENSION(6,6) :: TypeInterp ! TYPE of interpolation (linear, 
-                                         !   spline,...)  
-      TYPE(AGRIF_PVariable)    :: parent ! Variable on the parent grid
-      TYPE(AGRIF_PVariable)    :: child  ! Variable on the child grid 
-      INTEGER                  :: deb,fin ! Positions where interpolations 
-                                         !    are done
-      LOGICAL                  :: pweight ! Indicates if weight is used for 
-                                         !    the temporal interpolation
-      REAL                     :: weight ! Coefficient for the temporal
-                                         !    interpolation
-      INTEGER                  :: nbdim  ! Number of dimensions of the grid
-                                         !    variable
-      INTEGER,DIMENSION(nbdim) :: pttab_child ! Index of the first point inside
-                                         !    the domain for the parent 
-                                         !    grid variable
-      INTEGER,DIMENSION(nbdim) :: pttab_Parent ! Index of the first point 
-                                         !   inside the domain for the 
-                                         !   child grid variable
-      INTEGER,DIMENSION(nbdim) :: nbtab_Child ! Number of cells of the child
-                                         !    grid
-      INTEGER,DIMENSION(nbdim) :: posvartab_Child ! Position of the grid
-                                         !    variable (1 or 2)
-      INTEGER,DIMENSION(nbdim) :: loctab_Child ! Indicates if the child 
-                                        !    grid has a common border with 
-                                        !    the root grid
-      REAL   ,DIMENSION(nbdim) :: s_Child,s_Parent ! Positions of the parent 
-                                        !   and child grids 
-      REAL   ,DIMENSION(nbdim) :: ds_Child,ds_Parent ! Space steps of the 
-                                        !    parent and child grids
-C
-C     Local variables
-      TYPE(AGRIF_PVariable)        :: restore ! Variable on the parent     
-      INTEGER,DIMENSION(nbdim,2)   :: lubglob
-      INTEGER                      :: i          
-      INTEGER                      :: kindex  ! Index used for safeguard 
-                                       !    and time interpolation
-      INTEGER,DIMENSION(nbdim,2,2) :: indtab ! Arrays indicating the limits 
-                                       !    of the child     
-      INTEGER,DIMENSION(nbdim,2,2) :: indtruetab ! grid variable where 
-                                       !   boundary conditions are 
-      INTEGER,DIMENSION(nbdim,2,2,nbdim)   :: ptres,ptres2 ! calculated
-      INTEGER                      :: nb,ndir,n,sizetab(1)
-      REAL, DIMENSION(:), Allocatable :: tab ! Array used for the interpolation
-      REAL    :: c1t,c2t               ! Coefficients for the time interpolation
-                                       !    (c2t=1-c1t) 
-C
-#ifdef key_mpp_mpi
-C
-      INTEGER,DIMENSION(nbdim)   :: lower,upper
-      INTEGER,DIMENSION(nbdim)   :: ltab,utab
-      INTEGER,DIMENSION(nbdim)   :: lb,ub
-      INTEGER,DIMENSION(nbdim,2) :: iminmaxg
-      INTEGER                    :: code
-C
-#endif            
-C      
-C
-      indtab(1:nbdim,2,1) = pttab_child(1:nbdim) + nbtab_child(1:nbdim)
-     &          + deb
-      indtab(1:nbdim,2,2) = indtab(1:nbdim,2,1) + ( fin - deb )
-       
-      indtab(1:nbdim,1,1) = pttab_child(1:nbdim) - fin
-      indtab(1:nbdim,1,2) = pttab_child(1:nbdim) - deb
-                  
-      WHERE (posvartab_child(1:nbdim) == 2)
-        indtab(1:nbdim,1,1) = indtab(1:nbdim,1,1) - 1
-        indtab(1:nbdim,1,2) = indtab(1:nbdim,1,2) - 1
-      END WHERE
-      
-
-#if !defined key_mpp_mpi
-      Call Agrif_nbdim_Get_bound_dimension(child%var,lubglob(:,1),
-     &              lubglob(:,2),nbdim)
-C
-#else
-C     
-      Call Agrif_nbdim_Get_bound_dimension(child%var,lb,ub,nbdim)
-      
-      DO i = 1,nbdim
-C
-        Call Agrif_Invloc(lb(i),Agrif_Procrank,i,iminmaxg(i,1))
-        Call Agrif_Invloc(ub(i),Agrif_Procrank,i,iminmaxg(i,2))
-C
-      ENDDO
-C
-      iminmaxg(1:nbdim,2) = - iminmaxg(1:nbdim,2)
-      
-      CALL MPI_ALLREDUCE(iminmaxg,lubglob,2*nbdim,MPI_INTEGER,MPI_MIN,
-     &                     MPI_COMM_AGRIF,code)  
-     
-      lubglob(1:nbdim,2) = - lubglob(1:nbdim,2)      
-C
-#endif 
-C     
-      indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1),
-     &     lubglob(1:nbdim,1))
-      indtruetab(1:nbdim,1,2) = max(indtab(1:nbdim,1,2),
-     &     lubglob(1:nbdim,1))
-      indtruetab(1:nbdim,2,1) = min(indtab(1:nbdim,2,1),
-     &     lubglob(1:nbdim,2))
-      indtruetab(1:nbdim,2,2) = min(indtab(1:nbdim,2,2),
-     &     lubglob(1:nbdim,2))
-
-                              
-C 
-C
-      do nb = 1,nbdim
-C
-        do ndir = 1,2      
-C
-          if (loctab_child(nb) /= (-ndir) 
-     &        .AND. loctab_child(nb) /= -3) then
-C           
-              do n = 1,2
-C
-                ptres(nb,n,ndir,nb) = indtruetab(nb,ndir,n)  
-C
-              enddo              
-C
-              do i = 1,nbdim
-C     
-                if (i .NE. nb) then      
-C
-                    if (loctab_child(i) == -1 
-     &                                 .OR. loctab_child(i) == -3) then
-C
-                        ptres(i,1,ndir,nb) = pttab_child(i)
-C
-                      else
-C
-                        ptres(i,1,ndir,nb) = indtruetab(i,1,1)
-C
-                    endif
-C
-                    if (loctab_child(i) == -2 
-     &                                 .OR. loctab_child(i) == -3) then
-C
-                        if (posvartab_child(i) == 1) then
-C
-                            ptres(i,2,ndir,nb) = pttab_child(i)
-     &                                                 + nbtab_child(i)
-C
-                          else
-C
-                            ptres(i,2,ndir,nb) = pttab_child(i)
-     &                                             + nbtab_child(i) - 1
-C
-                        endif                             
-C
-                      else
-C
-                        ptres(i,2,ndir,nb) = indtruetab(i,2,2)
-C
-                    endif                        
-C      
-                endif
-C      
-              enddo
-      
-C
-#if defined key_mpp_mpi
-                 Call Agrif_nbdim_Get_bound_dimension
-     &                    (child%var,lower,upper,nbdim)
-
-              do i = 1,nbdim
-C
-                 Call GetLocalBoundaries(ptres(i,1,ndir,nb),
-     &                                  ptres(i,2,ndir,nb),i,
-     &                                  lower(i),upper(i),
-     &                                  ltab(i),utab(i))
-                 ptres2(i,1,ndir,nb) = max(ltab(i),lower(i)) 
-                 ptres2(i,2,ndir,nb) = min(utab(i),upper(i))
-                 if ((i == nb) .AND. (ndir == 1)) then 
-                     ptres2(i,2,ndir,nb) = max(utab(i),lower(i))
-                 elseif ((i == nb) .AND. (ndir == 2)) then
-                     ptres2(i,1,ndir,nb) = min(ltab(i),upper(i)) 
-                 endif
-C
-              enddo
-#else
-              ptres2(:,:,ndir,nb) = ptres(:,:,ndir,nb)
-#endif      
-            
-        endif
-      
-        enddo
-       enddo
-C
-      if (child % var % interpIndex 
-     &        /= Agrif_Curgrid % parent % ngridstep .OR.
-     &    child%var%Interpolationshouldbemade ) then
-C
-C     Space interpolation 
-C      
-      kindex = 1    
-      
-
-C
-      do nb = 1,nbdim
-C
-        do ndir = 1,2
-C
-          if (loctab_child(nb) /= (-ndir) 
-     &        .AND. loctab_child(nb) /= -3) then  
-C
-              IF (present(procname)) THEN
-              Call Agrif_InterpnD
-     &             (TYPEInterp(nb,:),parent,child,
-     &              ptres(1:nbdim,1,ndir,nb),ptres(1:nbdim,2,ndir,nb),
-     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
-     &              s_Child(1:nbdim),s_Parent(1:nbdim),
-     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
-     &              restore,.FALSE.,nbdim,procname)
-              ELSE
-              Call Agrif_InterpnD              
-     &             (TYPEInterp(nb,:),parent,child,
-     &              ptres(1:nbdim,1,ndir,nb),ptres(1:nbdim,2,ndir,nb),
-     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
-     &              s_Child(1:nbdim),s_Parent(1:nbdim),
-     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
-     &              restore,.FALSE.,nbdim)
-              ENDIF
-     
-              IF (.NOT. child%var%interpolationshouldbemade) THEN
-C     
-C             Safeguard of the values of the grid variable (at times n and n+1
-C                on the parent grid)
-C      
-              sizetab(1) = 1
-C
-              do i = 1,nbdim
-C          
-                sizetab(1) = sizetab(1)
-     &              * (ptres2(i,2,ndir,nb)-ptres2(i,1,ndir,nb)+1)
-C      
-              enddo
-
-              Call saveAfterInterp(child,
-     &           ptres2(:,:,ndir,nb),kindex,sizetab(1),nbdim)
-C
-           ENDIF
-C
-          endif
-C
-        enddo       
-C
-      enddo     
-C
-C
-      child % var % interpIndex = Agrif_Curgrid % parent % ngridstep
-C
-C
-      endif  
-      
-              IF (.NOT. child%var%interpolationshouldbemade) THEN
-C
-C
-C     Calculation of the coefficients c1t and c2t for the temporary
-C        interpolation
-      if (pweight) then
-C
-          c1t = weight
-C
-        else
-C
-          c1t = (REAL(AGRIF_Nbstepint()) + 1.) / Agrif_Rhot()
-C
-      endif
-C                                  
-      c2t = 1. - c1t
-C           
-C     Time interpolation
-C
-      kindex = 1
-C
-      do nb = 1,nbdim
-C
-        do ndir = 1,2      
-C
-          if (loctab_child(nb) /= (-ndir) 
-     &        .AND. loctab_child(nb) /= -3) then
-
-              Call timeInterpolation
-     &             (child,ptres2(:,:,ndir,nb),kindex,c1t,c2t,nbdim)
-          endif
-C
-        enddo
-C      
-      enddo
-C      
-
-       ENDIF
-C  
-      End Subroutine Agrif_Correctnd
-C
-C
-C     **************************************************************************
-CCC   Subroutine saveAfterInterp
-C     **************************************************************************
-C
-      Subroutine saveAfterInterp(child,bounds,kindex,newsize,nbdim)
-C
-CCC   Descritpion:
-CCC   Subroutine used to save the values of the grid variable on the fine grid 
-CCC   after the space interpolation. 
-C
-C     Declarations:
-C
-      
-C
-C     argument
-      TYPE (AGRIF_PVariable) :: child   ! The fine grid variable
-      INTEGER                :: kindex  ! Index indicating where this safeguard 
-                                        ! is done on the fine grid
-      INTEGER :: nbdim, newsize
-      INTEGER,DIMENSION(nbdim,2) :: bounds
-C
-C     Local scalars
-      INTEGER                      :: ir,jr,kr,lr,mr,nr
-C
-C
-C     Allocation of the array oldvalues2d
-
-C
-      if (newsize .LE. 0) return
-C
-      Call Agrif_Checksize
-     &     (child,kindex+newsize)  
-
-      if (child % var % interpIndex 
-     &        /= Agrif_Curgrid % parent % ngridstep ) then
-       child%var%oldvalues2d(1,kindex:kindex+newsize-1)=
-     &        child%var%oldvalues2d(2,kindex:kindex+newsize-1)
-      endif
-
-      SELECT CASE (nbdim)
-      CASE (1)
-
-!CDIR ALTCODE
-         do ir=bounds(1,1),bounds(1,2)
-            child%var%oldvalues2d(2,kindex) =
-     &           child%var%parray1(ir)
-            kindex = kindex + 1
-         enddo       
-C
-      CASE (2)
-
-        do jr=bounds(2,1),bounds(2,2)
-!CDIR ALTCODE
-           do ir=bounds(1,1),bounds(1,2)
-            child%var%oldvalues2d(2,kindex) =
-     &           child%var%parray2(ir,jr)
-            kindex = kindex + 1
-           enddo
-         enddo      
-C
-      CASE (3)
-        do kr=bounds(3,1),bounds(3,2)
-          do jr=bounds(2,1),bounds(2,2)
-!CDIR ALTCODE
-             do ir=bounds(1,1),bounds(1,2)
-            child%var%oldvalues2d(2,kindex) =
-     &           child%var%parray3(ir,jr,kr)
-            kindex = kindex + 1
-             enddo
-           enddo
-         enddo       
-C
-      CASE (4)
-          do lr=bounds(4,1),bounds(4,2)
-           do kr=bounds(3,1),bounds(3,2)
-             do jr=bounds(2,1),bounds(2,2)
-!CDIR ALTCODE
-               do ir=bounds(1,1),bounds(1,2)
-            child%var%oldvalues2d(2,kindex) =
-     &           child%var%parray4(ir,jr,kr,lr)
-            kindex = kindex + 1
-               enddo
-             enddo
-           enddo
-         enddo         
-C
-      CASE (5)
-         do mr=bounds(5,1),bounds(5,2)
-           do lr=bounds(4,1),bounds(4,2)
-            do kr=bounds(3,1),bounds(3,2) 
-              do jr=bounds(2,1),bounds(2,2)
-!CDIR ALTCODE
-                 do ir=bounds(1,1),bounds(1,2)
-            child%var%oldvalues2d(2,kindex) =
-     &           child%var%parray5(ir,jr,kr,lr,mr)
-            kindex = kindex + 1
-                 enddo
-               enddo
-             enddo
-           enddo
-         enddo   
-C
-      CASE (6)
-        do nr=bounds(6,1),bounds(6,2)
-           do mr=bounds(5,1),bounds(5,2)
-             do lr=bounds(4,1),bounds(4,2)
-               do kr=bounds(3,1),bounds(3,2)
-                do jr=bounds(2,1),bounds(2,2)
-!CDIR ALTCODE
-                   do ir=bounds(1,1),bounds(1,2)
-            child%var%oldvalues2d(2,kindex) =
-     &           child%var%parray6(ir,jr,kr,lr,mr,nr)
-            kindex = kindex + 1
-                   enddo
-                 enddo
-               enddo
-             enddo
-           enddo
-         enddo       
-      END SELECT
-C
-C                                                  
-      End subroutine saveAfterInterp
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine timeInterpolation
-C     **************************************************************************
-C
-      Subroutine timeInterpolation(child,bounds,kindex,c1t,c2t,nbdim) 
-C
-CCC   Descritpion:
-CCC   Subroutine for a linear time interpolation on the child grid. 
-C
-C     Declarations:
-C
-      
-C
-C     argument
-      TYPE (AGRIF_PVariable) :: child  ! The fine grid variable
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(nbdim,2) :: bounds
-      INTEGER                :: kindex ! Index indicating the values of the fine
-                                       ! grid got before and after the space 
-                                       ! interpolation and used for the time 
-                                       ! interpolation
-      REAL                   :: c1t,c2t! coefficients for the time interpolation
-                                       ! (c2t=1-c1t)  
-C
-C     Local aruments      
-      INTEGER :: i
-C     Local scalars
-      INTEGER                      :: ir,jr,kr,lr,mr,nr      
-C
-C
-      
-      SELECT CASE (nbdim)
-      CASE (1)
-
-!CDIR ALTCODE
-         do ir=bounds(1,1),bounds(1,2)
-                child%var%parray1(ir) =
-     &           c2t*child % var % oldvalues2d(1,kindex)   
-     &         + c1t*child % var % oldvalues2d(2,kindex)    
-            kindex = kindex + 1
-         enddo       
-C
-      CASE (2)
-
-        do jr=bounds(2,1),bounds(2,2)
-!CDIR ALTCODE
-           do ir=bounds(1,1),bounds(1,2)
-                child%var%parray2(ir,jr) =
-     &           c2t*child % var % oldvalues2d(1,kindex)   
-     &         + c1t*child % var % oldvalues2d(2,kindex) 
-            kindex = kindex + 1
-           enddo
-         enddo      
-C
-      CASE (3)
-        do kr=bounds(3,1),bounds(3,2)
-          do jr=bounds(2,1),bounds(2,2)
-!CDIR ALTCODE
-             do ir=bounds(1,1),bounds(1,2)
-                child%var%parray3(ir,jr,kr) =
-     &           c2t*child % var % oldvalues2d(1,kindex)   
-     &         + c1t*child % var % oldvalues2d(2,kindex) 
-            kindex = kindex + 1
-             enddo
-           enddo
-         enddo       
-C
-      CASE (4)
-          do lr=bounds(4,1),bounds(4,2)
-           do kr=bounds(3,1),bounds(3,2)
-             do jr=bounds(2,1),bounds(2,2)
-!CDIR ALTCODE
-               do ir=bounds(1,1),bounds(1,2)
-                child%var%parray4(ir,jr,kr,lr) =
-     &           c2t*child % var % oldvalues2d(1,kindex)   
-     &         + c1t*child % var % oldvalues2d(2,kindex) 
-            kindex = kindex + 1
-               enddo
-             enddo
-           enddo
-         enddo         
-C
-      CASE (5)
-         do mr=bounds(5,1),bounds(5,2)
-           do lr=bounds(4,1),bounds(4,2)
-            do kr=bounds(3,1),bounds(3,2) 
-              do jr=bounds(2,1),bounds(2,2)
-!CDIR ALTCODE
-                 do ir=bounds(1,1),bounds(1,2)
-                child%var%parray5(ir,jr,kr,lr,mr) =
-     &           c2t*child % var % oldvalues2d(1,kindex)   
-     &         + c1t*child % var % oldvalues2d(2,kindex) 
-            kindex = kindex + 1
-                 enddo
-               enddo
-             enddo
-           enddo
-         enddo   
-C
-      CASE (6)
-        do nr=bounds(6,1),bounds(6,2)
-           do mr=bounds(5,1),bounds(5,2)
-             do lr=bounds(4,1),bounds(4,2)
-               do kr=bounds(3,1),bounds(3,2)
-                do jr=bounds(2,1),bounds(2,2)
-!CDIR ALTCODE
-                   do ir=bounds(1,1),bounds(1,2)
-                child%var%parray6(ir,jr,kr,lr,mr,nr) =
-     &           c2t*child % var % oldvalues2d(1,kindex)   
-     &         + c1t*child % var % oldvalues2d(2,kindex) 
-            kindex = kindex + 1
-                   enddo
-                 enddo
-               enddo
-             enddo
-           enddo
-         enddo       
-      END SELECT
-                                                   
-C
-C
-      End subroutine timeInterpolation      
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Checksize
-C     **************************************************************************
-C
-      Subroutine Agrif_Checksize(child,newsize)
-C
-CCC   Descritpion:
-CCC   Subroutine used in the saveAfterInterp procedure to allocate the 
-CCC   oldvalues2d array. 
-C
-C     Declarations:
-C
-      
-C      
-C     TYPE argument
-      TYPE (AGRIF_PVariable) :: child  ! The fine grid variable
-C 
-C     Scalar arguments
-      INTEGER :: newsize               ! Size of the domains where the boundary 
-                                       ! conditions are calculated  
-C
-C     Local arrays
-      REAL, DIMENSION(:,:), Allocatable :: tempoldvalues ! Temporary array
-C                
-C
-      if (.NOT. associated(child % var % oldvalues2d)) then
-C
-          allocate(child % var % oldvalues2d(2,newsize))
-C  
-          child % var % oldvalues2d=0.
-C
-        else
-C
-          if (SIZE(child % var % oldvalues2d,2) < newsize) then   
-C
-              allocate(tempoldvalues(2,SIZE(child % var %
-     &                                    oldvalues2d,2)))
-C
-              tempoldvalues = child % var % oldvalues2d
-C
-              deallocate(child % var % oldvalues2d)
-C
-              allocate(child % var % oldvalues2d(2,newsize))
-C            
-              child%var%oldvalues2d=0.
-C
-              child % var % oldvalues2d(:,1:SIZE(tempoldvalues,2)) = 
-     &        tempoldvalues(:,:)
-C
-              deallocate(tempoldvalues)
-C
-          endif 
-C
-      endif                                                    
-C
-C
-      End  Subroutine Agrif_Checksize
-C
-C
-C
-C      
-      End Module AGRIF_boundary
-
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F90	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F90	(revision 6440)
@@ -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: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbcfunction.F
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbcfunction.F	(revision 6439)
+++ 	(revision )
@@ -1,2448 +1,0 @@
-!
-! $Id: modbcfunction.F 2715 2011-03-30 15:58:35Z rblod $
-!
-C     AGRIF (Adaptive Grid Refinement In Fortran)
-C
-C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
-C
-C     This program is free software; you can redistribute it and/or modify
-C     it under the terms of the GNU General Public License as published by
-C     the Free Software Foundation; either version 2 of the License, or
-C     (at your option) any later version.
-C
-C     This program is distributed in the hope that it will be useful,
-C     but WITHOUT ANY WARRANTY; without even the implied warranty of
-C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-C     GNU General Public License for more details.
-C
-C     You should have received a copy of the GNU General Public License
-C     along with this program; if not, write to the Free Software
-C     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-C
-C
-C
-CCC   Module AGRIF_bcfunction
-C
-C 
-      Module  Agrif_bcfunction
-CCC   Description:
-CCC   
-C
-C     Modules used:
-C  
-      Use Agrif_Boundary
-      Use Agrif_Update
-      Use Agrif_fluxmod
-      Use Agrif_Save
-C             
-      IMPLICIT NONE
-C
-      interface Agrif_Bc_variable
-          module procedure Agrif_Bc_variable0d,
-     &                     Agrif_Bc_variable1d,
-     &                     Agrif_Bc_variable2d,
-     &                     Agrif_Bc_variable3d,
-     &                     Agrif_Bc_variable4d,
-     &                     Agrif_Bc_variable5d
-      end interface       
-C
-      interface Agrif_Set_Parent
-          module procedure Agrif_Set_Parent_int,
-     &                     Agrif_Set_Parent_real
-      end interface       
-C
-      interface Agrif_Interp_variable
-          module procedure Agrif_Interp_var0d,
-     &                     Agrif_Interp_var1d,
-     &                     Agrif_Interp_var2d,
-     &                     Agrif_Interp_var3d,
-     &                     Agrif_Interp_var4d,
-     &                     Agrif_Interp_var5d
-      end interface       
-C
-      interface Agrif_Init_variable
-          module procedure Agrif_Init_variable0d,
-     &                     Agrif_Init_variable1d,
-     &                     Agrif_Init_variable2d,
-     &                     Agrif_Init_variable3d,
-     &                     Agrif_Init_variable4d
-      end interface       
-C
-      interface Agrif_update_variable
-          module procedure Agrif_update_var0d,
-     &                     Agrif_update_var1d,
-     &                     Agrif_update_var2d,
-     &                     Agrif_update_var3d,
-     &                     Agrif_update_var4d,
-     &                     Agrif_update_var5d
-      end interface       
-      
-      interface Agrif_Save_Forrestore
-         module procedure Agrif_Save_Forrestore0d,    
-     &                    Agrif_Save_Forrestore2d,    
-     &                    Agrif_Save_Forrestore3d,    
-     &                    Agrif_Save_Forrestore4d
-      end interface
-C
-      Contains 
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Set_type
-C     **************************************************************************
-C 
-      Subroutine Agrif_Set_type(tabvarsindic,posvar,point)
-C
-CCC   Description:
-CCC   To set the TYPE of the variable.
-C
-C     Modules used:
-C      
-
-C
-C     Declarations:
-C      
-C
-C
-C     Arguments      
-C
-      INTEGER, DIMENSION(:) :: posvar
-      INTEGER, DIMENSION(:) :: point
-C
-      INTEGER :: tabvarsindic ! indice of the variable in tabvars
-      INTEGER :: dimensio ! DIMENSION of the variable
-      INTEGER :: i
-C
-C
-C     Begin 
-C
-      dimensio = Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim
-C
-      if (.not.associated(Agrif_Mygrid % tabvars(tabvarsindic)
-     &                                 %var % posvar)) then
-      Allocate( 
-     & Agrif_Mygrid % tabvars(tabvarsindic)%var % posvar(dimensio))
-      endif 
-            
-      do i = 1 , dimensio
-         Agrif_Mygrid % tabvars(tabvarsindic) %var % posvar(i)
-     &                       = posvar(i)
-         Agrif_Mygrid % tabvars(tabvarsindic) %var % point(i) 
-     &                       = point(i)
-      enddo
-C
-C
-      End Subroutine Agrif_Set_type
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Set_parent_int
-C     **************************************************************************
-C 
-      Subroutine Agrif_Set_parent_int(tabvarsindic,value)
-C
-CCC   Description:
-CCC   To set the TYPE of the variable.
-C
-C     Modules used:
-C      
-
-C
-C     Declarations:
-C      
-C
-C
-C     Arguments      
-C
-      INTEGER :: tabvarsindic ! indice of the variable in tabvars
-      INTEGER :: Value
-C
-C     Begin 
-C
-      Agrif_Curgrid % parent % tabvars(tabvarsindic) % 
-     &         var % iarray0 = value
-C
-C
-      End Subroutine Agrif_Set_parent_int
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Set_parent_real
-C     **************************************************************************
-C 
-      Subroutine Agrif_Set_parent_real(tabvarsindic,value)
-C
-CCC   Description:
-CCC   To set the TYPE of the variable.
-C
-C     Modules used:
-C      
-
-C
-C     Declarations:
-C      
-C
-C
-C     Arguments      
-C
-      INTEGER :: tabvarsindic ! indice of the variable in tabvars
-      REAL :: Value
-C
-C     Begin 
-C
-      Agrif_Curgrid % parent % tabvars(tabvarsindic) % 
-     &          var % array0 = value
-C
-C
-      End Subroutine Agrif_Set_parent_real
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Set_raf
-C     **************************************************************************
-C 
-      Subroutine Agrif_Set_raf(tabvarsindic,tabraf)
-C
-CCC   Description:
-CCC   Attention tabraf est de taille trois si on ne raffine pas suivant z la
-CCC             troisieme entree du tableau tabraf est 'N'
-C
-C     Modules used:
-C      
-
-C
-C     Declarations:
-C      
-C     Arguments      
-C
-      CHARACTER(*) ,DIMENSION(:) :: tabraf
-C
-      INTEGER :: tabvarsindic ! indice of the variable in tabvars
-      INTEGER :: dimensio ! DIMENSION of the variable
-      INTEGER :: i
-C
-C
-C     Begin 
-C
-      dimensio = Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim
-C        
-      if (.not.associated(Agrif_Mygrid % tabvars(tabvarsindic)
-     &                                 %var % interptab)) then 
-      Allocate(
-     & Agrif_Mygrid % tabvars(tabvarsindic)%var% interptab(dimensio))
-      endif
-
-      do i = 1 , dimensio
-         Agrif_Mygrid % tabvars(tabvarsindic) %var % interptab(i) 
-     &                 = TRIM(tabraf(i))
-      enddo
-C
-      End Subroutine Agrif_Set_raf
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Set_bc
-C     **************************************************************************
-C 
-      Subroutine Agrif_Set_bc(tabvarsindic,point,
-     &          Interpolationshouldbemade)
-C
-CCC   Description:
-CCC
-C
-C     Modules used:
-C      
-
-C
-C     Declarations:
-C      
-C     Arguments      
-C
-      INTEGER, DIMENSION(2) :: point
-      LOGICAL, OPTIONAL :: Interpolationshouldbemade
-C
-      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
-      TYPE(Agrif_PVariable),Pointer ::tabvars
-      
-    
-C
-C
-C     Begin 
-C
-C     
-
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      endif  
-      
-      if (Agrif_Curgrid % fixedrank .NE. 0) then  
-       IF (.Not.Associated(tabvars%var% interpIndex)) THEN
-        Allocate(tabvars%var % interpIndex)
-          tabvars%var % interpIndex = -1
-
-        Allocate(tabvars%var % oldvalues2D(2,1))
-          tabvars%var % oldvalues2D = 0. 
-       ENDIF      
-       if ( PRESENT(Interpolationshouldbemade) ) then
-         tabvars%var %
-     &     Interpolationshouldbemade = Interpolationshouldbemade
-       endif
-
-      endif
-C
-      tabvars%var % bcinf = point(1)
-      tabvars%var % bcsup = point(2)
-C
-      End Subroutine Agrif_Set_bc
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Set_interp
-C     **************************************************************************
-C 
-      Subroutine Agrif_Set_interp(tabvarsindic,interp,interp1,interp2,
-     &                interp3)
-C
-CCC   Description:
-C
-C     Declarations:
-C      
-C     Arguments      
-C
-      INTEGER, OPTIONAL      :: interp,interp1,interp2,interp3
-C
-      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
-      TYPE(Agrif_PVariable),Pointer ::tabvars
-      
-    
-C
-C
-C     Begin 
-C
-C     
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif 
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-      else
-      tabvars=>Agrif_Mygrid % tabvars(indic)
-      endif      
-C
-C     Begin 
-C
-      tabvars % var % Typeinterp = 
-     &    Agrif_Constant
-      IF (present(interp)) THEN
-      tabvars % var % Typeinterp = 
-     &           interp
-      ENDIF
-      IF (present(interp1)) THEN
-      tabvars % var % Typeinterp(1) = 
-     &           interp1
-      ENDIF
-      IF (present(interp2)) THEN
-      tabvars % var % Typeinterp(2) = 
-     &           interp2
-      ENDIF
-      IF (present(interp3)) THEN
-      tabvars % var % Typeinterp(3) = 
-     &           interp3
-      ENDIF
-C
-      End Subroutine Agrif_Set_interp
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Set_bcinterp
-C     **************************************************************************
-C 
-      Subroutine Agrif_Set_bcinterp(tabvarsindic,interp,interp1,
-     &      interp2,interp3,interp11,interp12,interp21,interp22)
-C
-CCC   Description:
-
-C
-C     Modules used:
-C      
-
-C
-C     Declarations:
-C      
-C     Arguments      
-C
-      INTEGER, OPTIONAL      :: interp,interp1,interp2,interp3
-      INTEGER, OPTIONAL      :: interp11,interp12,interp21,interp22
-C
-      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
-      TYPE(Agrif_PVariable),Pointer ::tabvars
-      
-    
-C
-C
-C     Begin 
-C
-C     
-
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif 
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-      else
-      tabvars=>Agrif_Mygrid % tabvars(indic)
-      endif 
-C
-      tabvars% var % bctypeinterp = 
-     &           Agrif_Constant   
-      IF (present(interp)) THEN
-      tabvars% var % bctypeinterp = 
-     &           interp
-      ENDIF       
-      IF (present(interp1)) THEN
-      tabvars% var % bctypeinterp(1:2,1) = 
-     &           interp1
-      ENDIF       
-      IF (present(interp11)) THEN
-      tabvars% var % bctypeinterp(1,1) = 
-     &           interp11
-      ENDIF
-      IF (present(interp12)) THEN
-      tabvars% var % bctypeinterp(1,2) = 
-     &           interp12
-      ENDIF          
-      IF (present(interp2)) THEN
-      tabvars% var % bctypeinterp(1:2,2) = 
-     &           interp2
-      ENDIF
-      IF (present(interp21)) THEN
-      tabvars% var % bctypeinterp(2,1) = 
-     &           interp21
-      ENDIF      
-      IF (present(interp22)) THEN
-      tabvars% var % bctypeinterp(2,2) = 
-     &           interp22
-      ENDIF            
-      IF (present(interp3)) THEN
-      tabvars% var % bctypeinterp(1:2,3) =
-     &           interp3
-      ENDIF
-C
-      End Subroutine Agrif_Set_bcinterp
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Set_Update
-C     **************************************************************************
-C 
-      Subroutine Agrif_Set_Update(tabvarsindic,point)
-C
-CCC   Description:
-CCC
-C
-C     Modules used:
-C      
-
-C
-C     Declarations:
-C      
-C     Arguments      
-C
-      INTEGER, DIMENSION(2) :: point
-C
-      INTEGER :: tabvarsindic ! indice of the variable in tabvars
-C
-C
-C     Begin 
-C
-      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = point(1)
-      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = point(2)
-C
-      End Subroutine Agrif_Set_Update
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Set_UpdateType
-C     **************************************************************************
-C 
-      Subroutine Agrif_Set_UpdateType(tabvarsindic,
-     &                                  update,update1,update2,
-     &                                  update3,update4,update5)
-C
-CCC   Description:
-
-C
-C     Modules used:
-C      
-
-C
-C     Declarations:
-C      
-C     Arguments      
-C
-      INTEGER, OPTIONAL           :: update, update1,
-     &       update2, update3,update4,update5
-C
-      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
-      TYPE(Agrif_PVariable),Pointer :: roottabvars      
-C
-C
-C     Begin 
-
-      indic = tabvarsindic
-
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif 
-      
-      if (indic <=0) then
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)      
-      else
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif
-      
-C
-      roottabvars% var % typeupdate = 
-     &                   Agrif_Update_Copy
-      
-      IF (present(update)) THEN
-        roottabvars% var % typeupdate = 
-     &           update
-      ENDIF
-      IF (present(update1)) THEN
-        roottabvars% var % typeupdate(1) = 
-     &           update1
-      ENDIF  
-      IF (present(update2)) THEN
-        roottabvars% var % typeupdate(2) = 
-     &           update2
-      ENDIF  
-      IF (present(update3)) THEN
-        roottabvars% var % typeupdate(3) = 
-     &           update3
-      ENDIF 
-      IF (present(update4)) THEN
-        roottabvars% var % typeupdate(4) = 
-     &           update4
-      ENDIF       
-      IF (present(update5)) THEN
-        roottabvars% var % typeupdate(5) = 
-     &           update5
-      ENDIF                  
-C
-      End Subroutine Agrif_Set_UpdateType           
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Set_restore
-C     **************************************************************************
-C 
-      Subroutine Agrif_Set_restore(tabvarsindic)
-C
-CCC   Description:
-CCC   
-C
-C     Modules used:
-C      
-
-C
-C     Declarations:
-C      
-C     Arguments      
-C
-      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
-C
-C     Begin 
-C
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif  
-C
-      Agrif_Mygrid%tabvars(indic)%var % restaure = .TRUE.
-C
-      End Subroutine Agrif_Set_restore
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Init_variable0d
-C     **************************************************************************
-      Subroutine Agrif_Init_variable0d(tabvarsindic0,tabvarsindic,
-     &        procname)
-
-      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars
-      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
-      External :: procname
-      Optional ::  procname
-C
-      if (Agrif_Root()) Return
-C      
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif 
-      
-      if (present(procname)) then
-      CALL Agrif_Interp_variable(tabvarsindic0,indic,procname)
-      CALL Agrif_Bc_variable(tabvarsindic0,indic,1.,procname)
-      else
-      CALL Agrif_Interp_variable(tabvarsindic0,indic)
-      CALL Agrif_Bc_variable(tabvarsindic0,indic,1.)
-      endif
-
-      End Subroutine Agrif_Init_variable0d
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Init_variable1d
-C     **************************************************************************
-      Subroutine Agrif_Init_variable1d(q,tabvarsindic,procname)
-
-      REAL, DIMENSION(:) :: q
-      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
-      External :: procname
-      Optional ::  procname
-
-C
-      if (Agrif_Root()) Return
-C      
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif      
-C
-      if (present(procname)) then
-      CALL Agrif_Interp_variable(q,indic,procname)
-      CALL Agrif_Bc_variable(q,indic,1.,procname)
-      else
-      CALL Agrif_Interp_variable(q,indic)
-      CALL Agrif_Bc_variable(q,indic,1.)
-      endif
-
-      End Subroutine Agrif_Init_variable1d
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Init_variable2d
-C     **************************************************************************
-      Subroutine Agrif_Init_variable2d(q,tabvarsindic,procname)
-
-      REAL,  DIMENSION(:,:) :: q
-      INTEGER :: tabvarsindic ! indice of the variable in tabvars
-      External :: procname
-      Optional ::  procname
-      integer :: indic
-
-C
-      if (Agrif_Root()) Return
-C
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif 
-      
-      if (present(procname)) then
-      CALL Agrif_Interp_variable(q,indic,procname)
-      CALL Agrif_Bc_variable(q,indic,1.,procname)
-      else
-      CALL Agrif_Interp_variable(q,indic)
-      CALL Agrif_Bc_variable(q,indic,1.)
-      endif
-
-
-      End Subroutine Agrif_Init_variable2d
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Init_variable3d
-C     **************************************************************************
-      Subroutine Agrif_Init_variable3d(q,tabvarsindic,procname)
-
-      REAL,  DIMENSION(:,:,:) :: q
-      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
-      External :: procname
-      Optional ::  procname
-C
-      if (Agrif_Root()) Return
-C      
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif      
-C
-      if (present(procname)) then
-      CALL Agrif_Interp_variable(q,indic,procname)
-      CALL Agrif_Bc_variable(q,indic,1.,procname)
-      else
-      CALL Agrif_Interp_variable(q,indic)
-      CALL Agrif_Bc_variable(q,indic,1.)
-      endif
-
-C
-      End Subroutine Agrif_Init_variable3d
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Init_variable4d
-C     **************************************************************************
-      Subroutine Agrif_Init_variable4d(q,tabvarsindic,procname)
-
-      REAL,  DIMENSION(:,:,:,:) :: q
-      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
-      External :: procname
-      Optional ::  procname
-C
-      if (Agrif_Root()) Return
-C      
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif       
-C
-      if (present(procname)) then
-      CALL Agrif_Interp_variable(q,indic,procname)
-      CALL Agrif_Bc_variable(q,indic,1.,procname)
-      else
-      CALL Agrif_Interp_variable(q,indic)
-      CALL Agrif_Bc_variable(q,indic,1.)
-      endif
-
-C
-      End Subroutine Agrif_Init_variable4d      
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Bc_variable0d
-C     **************************************************************************
-      Subroutine Agrif_Bc_variable0d(tabvarsindic0,tabvarsindic,
-     &                               calledweight,procname)
-
-      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars
-      INTEGER :: tabvarsindic ! indice of the variable in tabvars
-C        
-      External :: procname
-      Optional ::  procname
-      REAL, OPTIONAL :: calledweight
-      REAL    :: weight
-      LOGICAL :: pweight
-C
-      INTEGER :: dimensio      
-
-      if (Agrif_Root()) Return
-C
-      dimensio =  Agrif_Mygrid % tabvars(tabvarsindic) % var % nbdim    
-C
-      if ( PRESENT(calledweight) ) then
-        weight=calledweight      
-        pweight = .TRUE.
-      else
-        weight = 0.
-        pweight = .FALSE.
-      endif
-C      
-C
-
-      
-      if ( dimensio .EQ. 1 ) Call Agrif_Interp_Bc_1D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array1,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
-     & weight,
-     & pweight)
-C
-      if ( dimensio .EQ. 2 ) then
-      IF (present(procname)) THEN
-      Call Agrif_Interp_Bc_2D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array2,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
-     & weight,pweight,procname)
-      ELSE
-          
-      Call Agrif_Interp_Bc_2D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array2,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
-     & weight,pweight)
-      ENDIF
-      endif
-C
-      if ( dimensio .EQ. 3 ) then
-      IF (present(procname)) THEN
-
-      Call Agrif_Interp_Bc_3D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array3,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
-     & weight,pweight,procname)      
-      ELSE
-      Call Agrif_Interp_Bc_3D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array3,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
-     & weight,pweight)
-      ENDIF
-      endif
-C
-      if ( dimensio .EQ. 4 ) then
-      IF (present(procname)) THEN
-      Call Agrif_Interp_Bc_4D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array4,     
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
-     & weight,pweight,procname)      
-      ELSE
-      Call Agrif_Interp_Bc_4D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array4,     
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
-     & weight,pweight)
-      ENDIF
-      endif
-C
-      if ( dimensio .EQ. 5 ) then
-      IF (present(procname)) THEN
-      Call Agrif_Interp_Bc_5D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array5,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
-     & weight,pweight,procname)      
-      ELSE
-      Call Agrif_Interp_Bc_5D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array5,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
-     & weight,pweight)
-      ENDIF
-      endif
-C
-      if ( dimensio .EQ. 6 ) Call Agrif_Interp_Bc_6D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array6,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
-     & weight,
-     & pweight)
-C
-C
-      End Subroutine Agrif_Bc_variable0d
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Bc_variable1d
-C     **************************************************************************
-      Subroutine Agrif_Bc_variable1d(q,tabvarsindic,calledweight,
-     &                               procname)
-
-      REAL   , Dimension(:)          :: q
-      External :: procname
-      Optional ::  procname
-      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
-C        
-      REAL, OPTIONAL :: calledweight
-      REAL    :: weight
-      LOGICAL :: pweight
-      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars
-C
-C      
-C      
-      If (Agrif_Root()) Return
-C      
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif         
-      
-      if ( PRESENT(calledweight) ) then
-        weight=calledweight      
-        pweight = .TRUE.
-      else
-        weight = 0.
-        pweight = .FALSE.
-      endif
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      parenttabvars => tabvars%parent_var
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif
-            
-      IF (present(procname)) THEN
-      Call Agrif_Interp_Bc_1D(
-     & roottabvars % var % bctypeinterp,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % bcinf,
-     & tabvars % var % bcsup,
-     & weight,pweight,procname)      
-      ELSE
-      Call Agrif_Interp_Bc_1D(
-     & roottabvars % var % bctypeinterp,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % bcinf,
-     & tabvars % var % bcsup,
-     & weight,pweight)
-      ENDIF
-      End Subroutine Agrif_Bc_variable1d 
-      
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Bc_variable2d
-C     **************************************************************************
-      Subroutine Agrif_Bc_variable2d(q,tabvarsindic,calledweight,
-     &                               procname)
-
-      REAL   , Dimension(:,:)          :: q
-      External :: procname
-      Optional ::  procname
-      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
-C        
-      REAL, OPTIONAL :: calledweight
-      REAL    :: weight
-      LOGICAL :: pweight
-      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars
-C
-C      
-C      
-      If (Agrif_Root()) Return
-C      
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif       
-      
-      if ( PRESENT(calledweight) ) then
-        weight=calledweight      
-        pweight = .TRUE.
-      else
-        weight = 0.
-        pweight = .FALSE.
-      endif
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      parenttabvars => tabvars%parent_var
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif
-            
-      IF (present(procname)) THEN
-      Call Agrif_Interp_Bc_2D(
-     & roottabvars % var % bctypeinterp,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % bcinf,
-     & tabvars % var % bcsup,
-     & weight,pweight,procname)      
-      ELSE
-      Call Agrif_Interp_Bc_2D(
-     & roottabvars % var % bctypeinterp,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % bcinf,
-     & tabvars % var % bcsup,
-     & weight,pweight)
-      ENDIF
-      End Subroutine Agrif_Bc_variable2d
-            
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Bc_variable3d
-C     **************************************************************************
-      Subroutine Agrif_Bc_variable3d(q,tabvarsindic,calledweight,
-     &                               procname)
-
-      REAL   , Dimension(:,:,:)          :: q
-      External :: procname
-      Optional ::  procname
-      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
-C        
-      REAL, OPTIONAL :: calledweight
-      REAL    :: weight
-      LOGICAL :: pweight
-      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars
-C
-C      
-C      
-      If (Agrif_Root()) Return
-C      
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif       
-      
-      if ( PRESENT(calledweight) ) then
-        weight=calledweight      
-        pweight = .TRUE.
-      else
-        weight = 0.
-        pweight = .FALSE.
-      endif
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      parenttabvars => tabvars%parent_var
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif
-            
-      IF (present(procname)) THEN
-      Call Agrif_Interp_Bc_3D(
-     & roottabvars % var % bctypeinterp,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % bcinf,
-     & tabvars % var % bcsup,
-     & weight,pweight,procname)      
-      ELSE
-      Call Agrif_Interp_Bc_3D(
-     & roottabvars % var % bctypeinterp,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % bcinf,
-     & tabvars % var % bcsup,
-     & weight,pweight)
-      ENDIF
-      End Subroutine Agrif_Bc_variable3d
-      
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Bc_variable4d
-C     **************************************************************************
-      Subroutine Agrif_Bc_variable4d(q,tabvarsindic,calledweight,
-     &                               procname)
-
-      REAL   , Dimension(:,:,:,:)          :: q
-      External :: procname
-      Optional ::  procname
-      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
-C        
-      REAL, OPTIONAL :: calledweight
-      REAL    :: weight
-      LOGICAL :: pweight
-      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars
-C
-C      
-C      
-      If (Agrif_Root()) Return
-      
-C      
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif      
-      
-      if ( PRESENT(calledweight) ) then
-        weight=calledweight      
-        pweight = .TRUE.
-      else
-        weight = 0.
-        pweight = .FALSE.
-      endif
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      parenttabvars => tabvars%parent_var
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif
-            
-      IF (present(procname)) THEN
-      Call Agrif_Interp_Bc_4D(
-     & roottabvars % var % bctypeinterp,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % bcinf,
-     & tabvars % var % bcsup,
-     & weight,pweight,procname)      
-      ELSE
-      Call Agrif_Interp_Bc_4D(
-     & roottabvars % var % bctypeinterp,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % bcinf,
-     & tabvars % var % bcsup,
-     & weight,pweight)
-      ENDIF
-      End Subroutine Agrif_Bc_variable4d
-            
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Bc_variable5d
-C     **************************************************************************
-      Subroutine Agrif_Bc_variable5d(q,tabvarsindic,calledweight,
-     &                               procname)
-
-      REAL   , Dimension(:,:,:,:,:)          :: q
-      External :: procname
-      Optional ::  procname
-      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
-C        
-      REAL, OPTIONAL :: calledweight
-      REAL    :: weight
-      LOGICAL :: pweight
-      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars
-C
-C      
-C      
-      If (Agrif_Root()) Return
-C      
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif      
-      
-      if ( PRESENT(calledweight) ) then
-        weight=calledweight      
-        pweight = .TRUE.
-      else
-        weight = 0.
-        pweight = .FALSE.
-      endif
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      parenttabvars => tabvars%parent_var
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif
-            
-      IF (present(procname)) THEN
-      Call Agrif_Interp_Bc_5d(
-     & roottabvars % var % bctypeinterp,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % bcinf,
-     & tabvars % var % bcsup,
-     & weight,pweight,procname)      
-      ELSE
-      Call Agrif_Interp_Bc_5d(
-     & roottabvars % var % bctypeinterp,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % bcinf,
-     & tabvars % var % bcsup,
-     & weight,pweight)
-      ENDIF
-      End Subroutine Agrif_Bc_variable5d
-      
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_var0D
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_var0d(tabvarsindic0,tabvarsindic,procname)
-
-      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars
-      INTEGER :: tabvarsindic, indic  ! indice of the variable in tabvars
-      INTEGER :: dimensio  ! indice of the variable in tabvars
-      External :: procname
-      Optional ::  procname
-C      
-      if (Agrif_Root()) Return
-C     
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif       
-C     
-      dimensio = Agrif_Mygrid % tabvars(indic) % var % nbdim 
-C
-      if ( dimensio .EQ. 1 ) then
-       if (present(procname)) then
-       Call Agrif_Interp_1D(
-     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
-     & Agrif_Curgrid % parent % tabvars(indic),
-     & Agrif_Curgrid % tabvars(indic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,     
-     & Agrif_Mygrid % tabvars(indic) % var % restaure,
-     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname)
-       else
-       Call Agrif_Interp_1D(
-     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
-     & Agrif_Curgrid % parent % tabvars(indic),
-     & Agrif_Curgrid % tabvars(indic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,     
-     & Agrif_Mygrid % tabvars(indic) % var % restaure,
-     & Agrif_Mygrid % tabvars(indic) %var % nbdim)
-       endif
-       endif
-C
-      if ( dimensio .EQ. 2 ) then
-      if (present(procname)) then
-       Call Agrif_Interp_2D(
-     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
-     & Agrif_Curgrid % parent % tabvars(indic),
-     & Agrif_Curgrid % tabvars(indic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,     
-     & Agrif_Mygrid % tabvars(indic) % var % restaure,
-     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname)
-      else
-       Call Agrif_Interp_2D(
-     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
-     & Agrif_Curgrid % parent % tabvars(indic),
-     & Agrif_Curgrid % tabvars(indic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,     
-     & Agrif_Mygrid % tabvars(indic) % var % restaure,
-     & Agrif_Mygrid % tabvars(indic) %var % nbdim)
-      endif
-      endif
-C
-      if ( dimensio .EQ. 3 ) then
-      if (present(procname)) then
-       Call Agrif_Interp_3D(
-     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
-     & Agrif_Curgrid % parent % tabvars(indic),
-     & Agrif_Curgrid % tabvars(indic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,     
-     & Agrif_Mygrid % tabvars(indic) % var % restaure,
-     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname)
-      else
-       Call Agrif_Interp_3D(
-     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
-     & Agrif_Curgrid % parent % tabvars(indic),
-     & Agrif_Curgrid % tabvars(indic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,     
-     & Agrif_Mygrid % tabvars(indic) % var % restaure,
-     & Agrif_Mygrid % tabvars(indic) %var % nbdim)
-      endif
-      endif
-C
-      if ( dimensio .EQ. 4 ) then
-      if (present(procname)) then
-       Call Agrif_Interp_4D(
-     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
-     & Agrif_Curgrid % parent % tabvars(indic),
-     & Agrif_Curgrid % tabvars(indic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,     
-     & Agrif_Mygrid % tabvars(indic) % var % restaure,
-     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname)
-      else
-       Call Agrif_Interp_4D(
-     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
-     & Agrif_Curgrid % parent % tabvars(indic),
-     & Agrif_Curgrid % tabvars(indic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,     
-     & Agrif_Mygrid % tabvars(indic) % var % restaure,
-     & Agrif_Mygrid % tabvars(indic) %var % nbdim)
-      endif
-      endif
-C
-      if ( dimensio .EQ. 5 ) then
-      if (present(procname)) then
-       Call Agrif_Interp_5D(
-     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
-     & Agrif_Curgrid % parent % tabvars(indic),
-     & Agrif_Curgrid % tabvars(indic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,     
-     & Agrif_Mygrid % tabvars(indic) % var % restaure,
-     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname)
-      else
-       Call Agrif_Interp_5D(
-     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
-     & Agrif_Curgrid % parent % tabvars(indic),
-     & Agrif_Curgrid % tabvars(indic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,     
-     & Agrif_Mygrid % tabvars(indic) % var % restaure,
-     & Agrif_Mygrid % tabvars(indic) %var % nbdim)
-       endif
-       endif
-C
-      if ( dimensio .EQ. 6 ) then
-      if (present(procname)) then
-       Call Agrif_Interp_6D(
-     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
-     & Agrif_Curgrid % parent % tabvars(indic),
-     & Agrif_Curgrid % tabvars(indic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array6 ,     
-     & Agrif_Mygrid % tabvars(indic) % var % restaure,
-     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname)
-      else
-       Call Agrif_Interp_6D(
-     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
-     & Agrif_Curgrid % parent % tabvars(indic),
-     & Agrif_Curgrid % tabvars(indic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array6 ,     
-     & Agrif_Mygrid % tabvars(indic) % var % restaure,
-     & Agrif_Mygrid % tabvars(indic) %var % nbdim)
-      endif
-      endif
-C
-      Return
-      End Subroutine Agrif_Interp_var0d
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_var1d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_var1d(q,tabvarsindic,procname)
-
-      REAL, DIMENSION(:) :: q
-      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
-      External :: procname
-      Optional ::  procname
-      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars      
-C
-      if (Agrif_Root()) Return
-C      
-C      
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif 
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      parenttabvars => tabvars%parent_var
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif
-      
-      if (present(procname)) then
-      Call Agrif_Interp_1D(
-     & roottabvars % var %  TypeInterp,
-     & parenttabvars,
-     & tabvars,q,
-     & roottabvars % var % restaure,
-     & roottabvars %var % nbdim,procname)
-      else
-      Call Agrif_Interp_1D(
-     & roottabvars % var %  TypeInterp,
-     & parenttabvars,
-     & tabvars,q,
-     & roottabvars % var % restaure,
-     & roottabvars %var % nbdim)
-     
-      endif
-      Return
-      End Subroutine Agrif_Interp_var1d
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_var2d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_var2d(q,tabvarsindic,procname)
-
-      REAL,  DIMENSION(:,:) :: q
-      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
-      External :: procname
-      Optional ::  procname
-      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars      
-C
-       if (Agrif_Root()) Return
-C      
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif 
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      parenttabvars => tabvars%parent_var
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-      if (tabvars%var%restaure) then
-        if (agrif_curgrid%ngridstep == 0) then
-          call AGRIF_CopyFromold_AllOneVar
-     &            (Agrif_Curgrid,Agrif_OldMygrid,indic)
-        endif
-      endif
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif
-
-            
-       if (present(procname)) then
-       Call Agrif_Interp_2D(
-     & roottabvars % var %  TypeInterp,
-     & parenttabvars,
-     & tabvars,q,
-     & roottabvars % var % restaure,
-     & roottabvars %var % nbdim,procname)
-       else
-       Call Agrif_Interp_2D(
-     & roottabvars % var %  TypeInterp,
-     & parenttabvars,
-     & tabvars,q,
-     & roottabvars % var % restaure,
-     & roottabvars %var % nbdim)
-     
-      endif 
-      Return
-      End Subroutine Agrif_Interp_var2d
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_var3d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_var3d(q,tabvarsindic,procname)
-
-      REAL,  DIMENSION(:,:,:) :: q
-      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
-      External :: procname
-      Optional ::  procname
-      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars      
-C
-      if (Agrif_Root()) Return
-C      
-
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif 
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      parenttabvars => tabvars%parent_var
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-      if (tabvars%var%restaure) then
-        if (agrif_curgrid%ngridstep == 0) then
-          call AGRIF_CopyFromold_AllOneVar
-     &            (Agrif_Curgrid,Agrif_OldMygrid,indic)
-        endif
-      endif      
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif
-
-      if (present(procname)) then
-      Call Agrif_Interp_3D(
-     & roottabvars % var %  TypeInterp,
-     & parenttabvars,
-     & tabvars,q,
-     & roottabvars % var % restaure,
-     & roottabvars %var % nbdim,procname)
-      else
-      Call Agrif_Interp_3D(
-     & roottabvars % var %  TypeInterp,
-     & parenttabvars,
-     & tabvars,q,
-     & roottabvars % var % restaure,
-     & roottabvars %var % nbdim)
-     
-      endif   
-      Return
-      End Subroutine Agrif_Interp_var3d
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_var4d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_var4d(q,tabvarsindic,procname)
-
-      REAL,  DIMENSION(:,:,:,:) :: q
-      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
-      External :: procname
-      Optional ::  procname
-      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars  
-C
-      if (Agrif_Root()) Return
-C      
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif 
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      parenttabvars => tabvars%parent_var
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-      if (tabvars%var%restaure) then
-        if (agrif_curgrid%ngridstep == 0) then
-          call AGRIF_CopyFromold_AllOneVar
-     &            (Agrif_Curgrid,Agrif_OldMygrid,indic)
-        endif
-      endif      
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif
-            
-      if (present(procname)) then
-      Call Agrif_Interp_4D(
-     & roottabvars % var %  TypeInterp,
-     & parenttabvars,
-     & tabvars,q,
-     & roottabvars % var % restaure,
-     & roottabvars %var % nbdim,procname)
-      else
-      Call Agrif_Interp_4D(
-     & roottabvars % var %  TypeInterp,
-     & parenttabvars,
-     & tabvars,q,
-     & roottabvars % var % restaure,
-     & roottabvars %var % nbdim)
-     
-      endif      
-
-      Return
-      End Subroutine Agrif_Interp_var4d     
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_var5d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_var5d(q,tabvarsindic,procname)
-
-      REAL,  DIMENSION(:,:,:,:,:) :: q
-      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
-      External :: procname
-      Optional ::  procname
-      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars      
-C
-      if (Agrif_Root()) Return
-C      
-
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif 
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      parenttabvars => tabvars%parent_var
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif
-      
-      if (present(procname)) then
-      Call Agrif_Interp_5D(
-     & roottabvars % var %  TypeInterp,
-     & parenttabvars,
-     & tabvars,q,
-     & roottabvars % var % restaure,
-     & roottabvars %var % nbdim,procname)
-      else
-      Call Agrif_Interp_5D(
-     & roottabvars % var %  TypeInterp,
-     & parenttabvars,
-     & tabvars,q,
-     & roottabvars % var % restaure,
-     & roottabvars %var % nbdim)
-     
-      endif
-      Return
-      End Subroutine Agrif_Interp_var5d       
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_update_var0d
-C     **************************************************************************
-C 
-      Subroutine Agrif_update_var0d(tabvarsindic0,tabvarsindic,
-     &                              locupdate,locupdate1,
-     &                  locupdate2,procname)
-
-      INTEGER :: tabvarsindic ! indice of the variable in tabvars
-      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars
-      External :: procname
-      Optional ::  procname      
-      INTEGER :: dimensio
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2            
-C
-      dimensio = Agrif_Mygrid % tabvars(tabvarsindic) % var % nbdim 
-C      
-      if (Agrif_Root()) Return
-      
-C     
-      IF (present(locupdate)) THEN
-      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:dimensio)
-     &      = locupdate(1)
-      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:dimensio) 
-     &      = locupdate(2)
-      ELSE
-      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:dimensio) 
-     &      = -99
-      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:dimensio) 
-     &      = -99
-      ENDIF
-      
-      IF (present(locupdate1)) THEN
-      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1) 
-     &      = locupdate1(1)
-      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1) 
-     &      = locupdate1(2)
-      ENDIF  
-      
-      IF (present(locupdate2)) THEN
-      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(2) 
-     &      = locupdate2(1)
-      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(2) 
-     &      = locupdate2(2)
-      ENDIF             
- 
-      if ( dimensio .EQ. 1 ) then
-      IF (present(procname)) THEN
-      Call Agrif_Update_1D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,     
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
-     & procname)
-      ELSE
-      Call Agrif_Update_1D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,     
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)      
-      ENDIF
-      endif
-      if ( dimensio .EQ. 2 ) then
-      IF (present(procname)) THEN
-      Call Agrif_Update_2D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,     
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
-     & procname)
-      ELSE
-      Call Agrif_Update_2D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,     
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)      
-      ENDIF
-      endif
-      if ( dimensio .EQ. 3 ) then
-      IF (present(procname)) THEN
-      Call Agrif_Update_3D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,     
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
-     & procname)
-      ELSE
-      Call Agrif_Update_3D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,     
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)      
-      ENDIF
-      endif
-      if ( dimensio .EQ. 4 ) then
-      IF (present(procname)) THEN
-      Call Agrif_Update_4D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,     
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
-     & procname)
-      ELSE
-      Call Agrif_Update_4D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,     
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)      
-      ENDIF
-      endif
-      if ( dimensio .EQ. 5 ) then
-      IF (present(procname)) THEN
-      Call Agrif_Update_5D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,     
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
-     & procname)
-      ELSE
-      Call Agrif_Update_5D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,     
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)      
-      ENDIF
-      endif
-
-      Return
-      End Subroutine Agrif_update_var0d
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_update_var1d
-C     **************************************************************************
-C 
-      Subroutine Agrif_update_var1d(q,tabvarsindic,locupdate,
-     &  locupdate1,locupdate2,procname)
-
-      REAL,  DIMENSION(:) :: q
-      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
-      External :: procname
-      Optional ::  procname      
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2        
-      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars   
-C      
-      if (Agrif_Root()) Return
-C     
-
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif 
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      parenttabvars => tabvars%parent_var
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)      
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif
-      
-      IF (present(locupdate)) THEN
-      tabvars%var % updateinf(1:1) 
-     &      = locupdate(1)
-      tabvars%var % updatesup(1:1) 
-     &      = locupdate(2)
-      ELSE
-      tabvars%var % updateinf(1:1) 
-     &      = -99
-      tabvars%var % updatesup(1:1) 
-     &      = -99
-      ENDIF
-      
-      IF (present(locupdate1)) THEN
-      tabvars%var % updateinf(1) 
-     &      = locupdate1(1)
-      tabvars%var % updatesup(1) 
-     &      = locupdate1(2)
-      ENDIF  
-      
-      IF (present(locupdate2)) THEN
-      tabvars%var % updateinf(2) 
-     &      = locupdate2(1)
-      tabvars%var % updatesup(2) 
-     &      = locupdate2(2)
-      ENDIF       
- 
-      IF (present(procname)) THEN
-      Call Agrif_Update_1D(
-     & roottabvars % var % typeupdate,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % updateinf,
-     & tabvars % var % updatesup,
-     & procname)
-      ELSE 
-      Call Agrif_Update_1D(
-     & roottabvars % var % typeupdate,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % updateinf,
-     & tabvars % var % updatesup)       
-      ENDIF
-
-      Return
-      End Subroutine Agrif_update_var1d
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_update_var2d
-C     **************************************************************************
-C 
-      Subroutine Agrif_update_var2d(q,tabvarsindic,locupdate,
-     &  locupdate1,locupdate2,procname)
-
-      REAL,  DIMENSION(:,:) :: q
-      External :: procname
-      Optional ::  procname
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate 
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2        
-      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
-      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars       
-C      
-      IF (Agrif_Root()) RETURN
-      
-C 
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif 
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      parenttabvars => tabvars%parent_var
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)      
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif
-      
-      IF (present(locupdate)) THEN
-      tabvars%var % updateinf(1:2) 
-     &      = locupdate(1)
-      tabvars%var % updatesup(1:2) 
-     &      = locupdate(2)
-      ELSE
-      tabvars%var % updateinf(1:2) 
-     &      = -99
-      tabvars%var % updatesup(1:2) 
-     &      = -99
-      ENDIF
-      
-      IF (present(locupdate1)) THEN
-      tabvars%var % updateinf(1) 
-     &      = locupdate1(1)
-      tabvars%var % updatesup(1) 
-     &      = locupdate1(2)
-      ENDIF  
-      
-      IF (present(locupdate2)) THEN
-      tabvars%var % updateinf(2) 
-     &      = locupdate2(1)
-      tabvars%var % updatesup(2) 
-     &      = locupdate2(2)
-      ENDIF
- 
-      IF (present(procname)) THEN
-      Call Agrif_Update_2D(
-     & roottabvars % var % typeupdate,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % updateinf,
-     & tabvars % var % updatesup,
-     & procname)
-      ELSE 
-      Call Agrif_Update_2D(
-     & roottabvars % var % typeupdate,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % updateinf,
-     & tabvars % var % updatesup)       
-      ENDIF
-
-      Return
-      End Subroutine Agrif_update_var2d
-C 
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_update_var3d
-C     **************************************************************************
-C 
-      Subroutine Agrif_update_var3d(q,tabvarsindic,locupdate,
-     &  locupdate1,locupdate2,procname)
-
-      REAL,  DIMENSION(:,:,:) :: q
-      External :: procname
-      Optional ::  procname
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2        
-      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
-      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars       
-C      
-      IF (Agrif_Root()) RETURN 
-C      
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif 
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      parenttabvars => tabvars%parent_var
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)      
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif
-      
-      IF (present(locupdate)) THEN
-      tabvars%var % updateinf(1:3) 
-     &      = locupdate(1)
-      tabvars%var % updatesup(1:3) 
-     &      = locupdate(2)
-      ELSE
-      tabvars%var % updateinf(1:3) 
-     &      = -99
-      tabvars%var % updatesup(1:3) 
-     &      = -99
-      ENDIF      
-      
-      IF (present(locupdate1)) THEN
-      tabvars%var % updateinf(1) 
-     &      = locupdate1(1)
-      tabvars%var % updatesup(1) 
-     &      = locupdate1(2)
-      ENDIF  
-      
-      IF (present(locupdate2)) THEN
-      tabvars%var % updateinf(2) 
-     &      = locupdate2(1)
-      tabvars%var % updatesup(2) 
-     &      = locupdate2(2)
-      ENDIF
-
-      IF (present(procname)) THEN
-      Call Agrif_Update_3D(
-     & roottabvars % var % typeupdate,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % updateinf,
-     & tabvars % var % updatesup,
-     & procname)
-      ELSE 
-      Call Agrif_Update_3D(
-     & roottabvars % var % typeupdate,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % updateinf,
-     & tabvars % var % updatesup)       
-      ENDIF
-
-      Return
-      End Subroutine Agrif_update_var3d
-C 
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_update_var4d
-C     **************************************************************************
-C 
-      Subroutine Agrif_update_var4d(q,tabvarsindic,locupdate,
-     &  locupdate1,locupdate2,procname)
-
-      REAL,  DIMENSION(:,:,:,:) :: q
-      External :: procname
-      Optional ::  procname
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2        
-      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
-      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars       
-C      
-      IF (Agrif_Root()) RETURN
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif 
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      parenttabvars => tabvars%parent_var
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)     
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif      
-C      
-      IF (present(locupdate)) THEN
-      tabvars%var % updateinf(1:4) 
-     &      = locupdate(1)
-      tabvars%var % updatesup(1:4) 
-     &      = locupdate(2)
-      ELSE
-      tabvars%var % updateinf(1:4) 
-     &      = -99
-      tabvars%var % updatesup(1:4) 
-     &      = -99
-      ENDIF
-      
-      IF (present(locupdate1)) THEN
-      tabvars%var % updateinf(1) 
-     &      = locupdate1(1)
-      tabvars%var % updatesup(1) 
-     &      = locupdate1(2)
-      ENDIF  
-      
-      IF (present(locupdate2)) THEN
-      tabvars%var % updateinf(2) 
-     &      = locupdate2(1)
-      tabvars%var % updatesup(2) 
-     &      = locupdate2(2)
-      ENDIF
-
-      IF (present(procname)) THEN
-      Call Agrif_Update_4D(
-     & roottabvars % var % typeupdate,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % updateinf,
-     & tabvars % var % updatesup,
-     & procname)
-      ELSE 
-      Call Agrif_Update_4D(
-     & roottabvars % var % typeupdate,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % updateinf,
-     & tabvars % var % updatesup)       
-      ENDIF
-
-      Return
-      End Subroutine Agrif_update_var4d  
-C 
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_update_var5d
-C     **************************************************************************
-C 
-      Subroutine Agrif_update_var5d(q,tabvarsindic,locupdate,
-     &  locupdate1,locupdate2,procname)
-
-      REAL,  DIMENSION(:,:,:,:,:) :: q
-      External :: procname
-      Optional ::  procname
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2        
-      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
-      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars       
-C
-      IF (Agrif_Root()) RETURN
-C      
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif 
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      parenttabvars => tabvars%parent_var
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)      
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif
-       
-      IF (present(locupdate)) THEN
-      tabvars%var % updateinf(1:5) 
-     &      = locupdate(1)
-      tabvars%var % updatesup(1:5) 
-     &      = locupdate(2)
-      ELSE
-      tabvars%var % updateinf(1:5) 
-     &      = -99
-      tabvars%var % updatesup(1:5) 
-     &      = -99
-      ENDIF
-      
-      IF (present(locupdate1)) THEN
-      tabvars%var % updateinf(1) 
-     &      = locupdate1(1)
-      tabvars%var % updatesup(1) 
-     &      = locupdate1(2)
-      ENDIF  
-      
-      IF (present(locupdate2)) THEN
-      tabvars%var % updateinf(2) 
-     &      = locupdate2(1)
-      tabvars%var % updatesup(2) 
-     &      = locupdate2(2)
-      ENDIF
-
-      IF (present(procname)) THEN
-      Call Agrif_Update_5D(
-     & roottabvars % var % typeupdate,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % updateinf,
-     & tabvars % var % updatesup,
-     & procname)
-      ELSE 
-      Call Agrif_Update_5D(
-     & roottabvars % var % typeupdate,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % updateinf,
-     & tabvars % var % updatesup)       
-      ENDIF
-
-      Return
-      End Subroutine Agrif_update_var5d  
-          
-      Subroutine Agrif_Declare_Flux(fluxname,profilename) 
-      character*(*) :: fluxname, profilename
-      Type(Agrif_Flux), pointer :: newflux
-      Type(Agrif_Profile), pointer  :: parcours
-      logical :: foundprofile
-      integer :: i,j,n
-            
-      foundprofile = .FALSE.
-      parcours => Agrif_Myprofiles
-      
-      Do While (Associated(parcours))
-         IF (parcours % profilename == profilename) THEN
-           foundprofile = .TRUE.
-           EXIT
-         ENDIF
-         parcours => parcours%nextprofile
-      End Do      
-      
-      IF (.NOT.foundprofile) THEN
-      write(*,*) 'The profile '''
-     &           //TRIM(profilename)//''' has not been declared'  
-      stop    
-      ENDIF
-      
-      Allocate(Newflux)
-      
-      Newflux % fluxname = fluxname
-      
-      Newflux % profile => parcours
-      
-      Newflux % nextflux => Agrif_Curgrid % fluxes
-      
-      Agrif_Curgrid % fluxes => Newflux
-      
-      End Subroutine Agrif_Declare_Flux  
-       
-      Subroutine Agrif_Save_Flux(fluxname, fluxtab)
-      character*(*) :: fluxname
-      REAL, DIMENSION(:,:) :: fluxtab
-      
-      
-      Type(Agrif_Flux), pointer :: Flux
-      
-      Type(Agrif_pgrid), pointer :: parcours_child
-      
-      Type(Agrif_grid), Pointer :: currentgrid,oldcurgrid
-      
-      IF (.Not.Agrif_Root()) THEN
-      Flux => Agrif_Search_Flux(fluxname)
-
-      IF (.NOT.Flux%fluxallocated) THEN
-        CALL Agrif_AllocateFlux(Flux,fluxtab)
-      ENDIF
-      
-      Call Agrif_Save_Fluxtab(Flux,fluxtab)
-      
-      ENDIF
-      
-      oldcurgrid=> Agrif_Curgrid
-      
-      parcours_child => Agrif_Curgrid%child_grids
-      
-      Do While (Associated(parcours_child))
-        currentgrid => parcours_child%gr
-        Agrif_Curgrid => parcours_child%gr
-        Flux => Agrif_Search_Flux(fluxname)
-        IF (.NOT.Flux%fluxallocated) THEN
-          CALL Agrif_AllocateFlux(Flux,fluxtab)
-        ENDIF        
-        Call Agrif_Save_Fluxtab_child(Flux,fluxtab)
-        parcours_child=> parcours_child%next
-      End Do
-      
-      Agrif_Curgrid=>oldcurgrid
-      
-      End Subroutine Agrif_Save_Flux
-
-      Subroutine Agrif_Cancel_Flux(fluxname)
-      character*(*) :: fluxname
-      
-      Type(Agrif_Flux), pointer :: Flux
-      
-      Flux => Agrif_Search_Flux(fluxname)
-
-      IF (Flux%FluxAllocated) Call Agrif_Cancel_Fluxarray(Flux)
-      
-      End Subroutine Agrif_Cancel_Flux
- 
-      Subroutine Agrif_Flux_Correction(fluxname, procname)
-      character*(*) :: fluxname
-      external :: procname
-      
-      Type(Agrif_Flux), pointer :: Flux
-      
-      Flux => Agrif_Search_Flux(fluxname)
-      
-      Call Agrif_FluxCorrect(Flux, procname)
-
-      
-      End Subroutine Agrif_Flux_Correction
-
-
-      
-      Subroutine Agrif_Declare_Profile_flux(profilename,posvar,
-     &    firstpoint,raf)
-      character*(*) :: profilename
-      Type(Agrif_Profile), Pointer :: newprofile
-      INTEGER, DIMENSION(:) :: posvar
-      INTEGER, DIMENSION(:) :: firstpoint
-      CHARACTER(*) ,DIMENSION(:) :: raf      
-      INTEGER :: dimensio
-            
-      dimensio = SIZE(posvar)
-C
-C    
-      Allocate(newprofile)
-      Allocate(newprofile%posvar(dimensio))
-      Allocate(newprofile%interptab(dimensio))
-      newprofile%profilename = profilename
-      newprofile%interptab = raf
-      newprofile%nbdim = dimensio
-      newprofile%posvar = posvar
-      newprofile%point(1:dimensio) = firstpoint
-      
-      newprofile % nextprofile => Agrif_myprofiles
-      
-      Agrif_myprofiles => newprofile
-      
-      End Subroutine Agrif_Declare_Profile_flux
-
-      Subroutine Agrif_Save_ForRestore0D(tabvarsindic0,tabvarsindic)
-      integer :: tabvarsindic0, tabvarsindic
-      integer :: dimensio
-              
-      dimensio =  Agrif_Mygrid % tabvars(tabvarsindic0) % var % nbdim
-      
-      select case(dimensio)
-      case(2)
-          call Agrif_Save_ForRestore2D(
-     &      Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2,
-     &      tabvarsindic)
-      case(3)
-          call Agrif_Save_ForRestore3D(
-     &      Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3,
-     &      tabvarsindic)
-      case(4)
-          call Agrif_Save_ForRestore4D(
-     &      Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4,
-     &      tabvarsindic)     
-      end select
-
-      Return
-      End Subroutine Agrif_Save_ForRestore0D 
-      
-    
-      
-      Subroutine Agrif_Save_ForRestore2D(q,tabvarsindic)
-      real,dimension(:,:) :: q
-      integer :: tabvarsindic, indic
-      TYPE(Agrif_PVariable),Pointer ::tabvars, roottabvars    
- 
-       indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif      
-      if (.not.allocated(tabvars%var%array2)) then      
-      allocate(tabvars%var%array2(tabvars%var%lb(1):tabvars%var%ub(1),
-     &                            tabvars%var%lb(2):tabvars%var%ub(2)))
-      endif
-      tabvars%var%array2 = q
-      roottabvars%var%restaure = .true.
-      
-      Return
-      End Subroutine Agrif_Save_ForRestore2D  
-      
-      Subroutine Agrif_Save_ForRestore3D(q,tabvarsindic)
-      real,dimension(:,:,:) :: q
-      integer :: tabvarsindic, indic
-      TYPE(Agrif_PVariable),Pointer ::tabvars, roottabvars    
- 
-       indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif      
-
-      if (.not.allocated(tabvars%var%array3)) then
-      allocate(tabvars%var%array3(tabvars%var%lb(1):tabvars%var%ub(1),
-     &                            tabvars%var%lb(2):tabvars%var%ub(2),
-     &                            tabvars%var%lb(3):tabvars%var%ub(3)))
-      endif
-      tabvars%var%array3 = q
-      roottabvars%var%restaure = .true.
-      
-      Return
-      End Subroutine Agrif_Save_ForRestore3D
-      
-      Subroutine Agrif_Save_ForRestore4D(q,tabvarsindic)
-      real,dimension(:,:,:,:) :: q
-      integer :: tabvarsindic, indic
-      TYPE(Agrif_PVariable),Pointer ::tabvars, roottabvars    
- 
-       indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif
-
-      if (.not.allocated(tabvars%var%array4)) then         
-      allocate(tabvars%var%array4(tabvars%var%lb(1):tabvars%var%ub(1),
-     &                            tabvars%var%lb(2):tabvars%var%ub(2),
-     &                            tabvars%var%lb(3):tabvars%var%ub(3),
-     &                            tabvars%var%lb(4):tabvars%var%ub(4)))
-      endif
-      tabvars%var%array4 = q
-      roottabvars%var%restaure = .true.
-      
-      Return
-      End Subroutine Agrif_Save_ForRestore4D                   
-C
-      End module Agrif_bcfunction
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbcfunction.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbcfunction.F90	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbcfunction.F90	(revision 6440)
@@ -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: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcluster.F
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcluster.F	(revision 6439)
+++ 	(revision )
@@ -1,1452 +1,0 @@
-!
-! $Id: modcluster.F 2715 2011-03-30 15:58:35Z rblod $
-!
-C     AGRIF (Adaptive Grid Refinement In Fortran)
-C
-C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
-C
-C     This program is free software; you can redistribute it and/or modify
-C     it under the terms of the GNU General Public License as published by
-C     the Free Software Foundation; either version 2 of the License, or
-C     (at your option) any later version.
-C
-C     This program is distributed in the hope that it will be useful,
-C     but WITHOUT ANY WARRANTY; without even the implied warranty of
-C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-C     GNU General Public License for more details.
-C
-C     You should have received a copy of the GNU General Public License
-C     along with this program; if not, write to the Free Software
-C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
-C
-C
-C
-CCC   Module AGRIF_Clustering  
-C
-C
-      Module Agrif_Clustering 
-C
-CCC   Description:
-CCC   Module to create and initialize the grid hierarchy from the 
-CCC   AGRIF_FixedGrids.in file.
-C
-C     Modules used:
-C  
-      Use Agrif_Curgridfunctions 
-      Use Agrif_Init_Vars
-      Use Agrif_Save
-C             
-      IMPLICIT NONE
-C        
-      Contains 
-C     Define procedures contained in this module
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Cluster_All  
-C     **************************************************************************
-C
-      Recursive Subroutine Agrif_Cluster_All(g,coarsegrid)
-C
-CCC   Description:
-CCC   Subroutine for the clustering. A temporary grid hierarchy, pointed by 
-CCC   coarsegrid, is created.
-C
-CC    Method:
-CC            
-C
-C     Declarations:
-C
-C     Pointer arguments    
-      TYPE(AGRIF_grid)     ,pointer   :: g        ! Pointer on the current grid
-      TYPE(AGRIF_rectangle),pointer   :: coarsegrid
-C      
-C     Local pointer         
-      TYPE(AGRIF_lrectangle),pointer  :: parcours 
-      TYPE(AGRIF_grid)      ,pointer  :: newgrid 
-      REAL                            :: g_eps
-      INTEGER                         :: iii
-C      
-      g_eps = huge(1.)
-      do iii = 1 , Agrif_Probdim
-         g_eps = min(g_eps,g%Agrif_d(iii))
-      enddo
-C
-      g_eps = g_eps/100.                  
-C
-C     Necessary condition for clustering 
-      do iii = 1 , Agrif_Probdim
-         if (g%Agrif_d(iii)/Agrif_coeffref(iii).LT.
-     &                   (Agrif_mind(iii)-g_eps)) Return
-      enddo
-C
-      Nullify(coarsegrid%childgrids)
-C
-      Call Agrif_ClusterGridnD(g,coarsegrid) 
-C
-      parcours => coarsegrid % childgrids                   
-C      
-      do while (associated(parcours))
-C      
-C       Newgrid is created. It is a copy of a fine grid created previously by
-C          clustering.      
-        Allocate(newgrid)
-C      
-        Nullify(newgrid%child_grids)
-C
-        do iii = 1 , Agrif_Probdim
-           newgrid % nb(iii) = (parcours % r % imax(iii) - 
-     &                          parcours % r % imin(iii)) *
-     &                          Agrif_Coeffref(iii)
-C        
-           newgrid % Agrif_x(iii) = g%Agrif_x(iii) + 
-     &                         (parcours %r % imin(iii) -1) 
-     &                         *g%Agrif_d(iii)
-C 
-           newgrid % Agrif_d(iii) = g%Agrif_d(iii) / Agrif_Coeffref(iii)
-C
-        enddo
-C
-        if ( Agrif_Probdim .EQ. 1 ) then
-           allocate(newgrid%tabpoint1D(newgrid%nb(1)+1))
-           newgrid%tabpoint1D = 0
-        endif
-C
-        if ( Agrif_Probdim .EQ. 2 ) then
-           allocate(newgrid%tabpoint2D(newgrid%nb(1)+1,
-     &                                 newgrid%nb(2)+1))
-           newgrid%tabpoint2D = 0      
-        endif
-C
-        if ( Agrif_Probdim .EQ. 3 ) then
-           allocate(newgrid%tabpoint3D(newgrid%nb(1)+1,
-     &                                 newgrid%nb(2)+1,
-     &                                 newgrid%nb(3)+1))
-           newgrid%tabpoint3D = 0
-        endif
-C       Points detection on newgrid
-        Call Agrif_TabpointsnD(Agrif_mygrid,newgrid) 
-C
-C       Recursive call to Agrif_Cluster_All            
-        Call Agrif_Cluster_All (newgrid, parcours % r)     
-C
-        parcours => parcours % next 
-C      
-        if ( Agrif_Probdim .EQ. 1 ) Deallocate(newgrid%tabpoint1D)
-        if ( Agrif_Probdim .EQ. 2 ) Deallocate(newgrid%tabpoint2D)
-        if ( Agrif_Probdim .EQ. 3 ) Deallocate(newgrid%tabpoint3D)
-C
-        Deallocate(newgrid)   
-C
-      enddo
-C
-C      
-      End Subroutine Agrif_Cluster_All
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_TabpointsnD
-C     **************************************************************************
-C
-      Recursive Subroutine Agrif_TabpointsnD(g,newgrid)
-C
-CCC   Description:
-CCC   Copy on newgrid of points detected on the grid hierarchy pointed by g.   
-C
-CC    Method:
-CC            
-C
-C     Declarations:
-C
-C     Arguments
-      TYPE(Agrif_Grid),pointer   :: g,newgrid
-C
-C     Local variables      
-      TYPE(Agrif_Pgrid),pointer  :: parcours
-C
-      REAL                  :: g_eps,newgrid_eps,eps
-      REAL   , DIMENSION(3) :: newmin,newmax
-      REAL   , DIMENSION(3) :: gmin,gmax
-      REAL   , DIMENSION(3) :: xmin
-      INTEGER, DIMENSION(3) :: igmin,inewmin
-      INTEGER, DIMENSION(3) :: inewmax
-      INTEGER               :: iii
-      INTEGER               :: i,j,k
-      INTEGER               :: i0,j0,k0
-C
-C     
-      parcours => g % child_grids
-C
-      do While(associated(parcours))
-        Call Agrif_TabpointsnD(parcours%gr,newgrid)
-        parcours => parcours % next
-      enddo      
-C
-      g_eps = 10.
-      newgrid_eps = 10.
-C      
-      do iii = 1 , Agrif_probdim
-         g_eps = min( g_eps , g % Agrif_d(iii) )
-         newgrid_eps = min(newgrid_eps,newgrid%Agrif_d(iii))
-      enddo
-C
-      eps = min(g_eps,newgrid_eps)/100.                  
-C                   
-      do iii = 1 , Agrif_probdim
-         if (newgrid%Agrif_d(iii) .LT. (g%Agrif_d(iii)-eps)) Return
-C                   
-         gmin(iii) = g%Agrif_x(iii)
-         gmax(iii) = g%Agrif_x(iii) + g%nb(iii) * g%Agrif_d(iii)
-C 
-         newmin(iii) = newgrid%Agrif_x(iii)
-         newmax(iii) = newgrid%Agrif_x(iii) + newgrid%nb(iii) *
-     &                 newgrid%Agrif_d(iii)
-C      
-         if (gmax(iii) .LT. newmin(iii)) Return
-C
-         if (gmin(iii) .GT. newmax(iii)) Return
-C           
-         inewmin(iii) = 1 - floor(-(max(gmin(iii),newmin(iii))-
-     &                    newmin(iii))
-     &                   /newgrid%Agrif_d(iii)) 
-C          
-         xmin(iii) = newgrid%Agrif_x(iii) + (inewmin(iii)-1)*
-     &              newgrid%Agrif_d(iii)          
-C        
-         igmin(iii) = 1 + nint((xmin(iii)-gmin(iii))/g%Agrif_d(iii))
-C
-         inewmax(iii) = 1 + int((min(gmax(iii),newmax(iii))-
-     &                  newmin(iii))/newgrid%Agrif_d(iii))
-      enddo
-C                
-      if ( Agrif_probdim .EQ. 1 ) then
-         i0 = igmin(1)
-         do i = inewmin(1),inewmax(1)
-            newgrid%tabpoint1D(i) = max(
-     &                           newgrid%tabpoint1D(i),
-     &                           g%tabpoint1D(i0))
-         enddo
-         i0 = i0 + int(newgrid%Agrif_d(1)/g%Agrif_d(1))
-      endif
-C
-      if ( Agrif_probdim .EQ. 2 ) then
-         i0 = igmin(1)
-         do i = inewmin(1),inewmax(1)
-            j0 = igmin(2)
-            do j = inewmin(2),inewmax(2)
-               newgrid%tabpoint2D(i,j) = max(
-     &                           newgrid%tabpoint2D(i,j),
-     &                           g%tabpoint2D(i0,j0))
-               j0 = j0 + int(newgrid%Agrif_d(2)/g%Agrif_d(2))
-            enddo
-            i0 = i0 + int(newgrid%Agrif_d(1)/g%Agrif_d(1))
-         enddo
-      endif
-C
-      if ( Agrif_probdim .EQ. 3 ) then
-         i0 = igmin(1)
-         do i = inewmin(1),inewmax(1)
-            j0 = igmin(2)
-            do j = inewmin(2),inewmax(2)
-               k0 = igmin(3)
-               do k = inewmin(3),inewmax(3)
-                  newgrid%tabpoint3D(i,j,k) = max(
-     &                           newgrid%tabpoint3D(i,j,k),
-     &                           g%tabpoint3D(i0,j0,k0))
-                  k0 = k0 + int(newgrid%Agrif_d(3)/g%Agrif_d(3))
-               enddo                                        
-               j0 = j0 + int(newgrid%Agrif_d(2)/g%Agrif_d(2))
-            enddo
-            i0 = i0 + int(newgrid%Agrif_d(1)/g%Agrif_d(1))
-         enddo
-      endif
-C
-      Return
-C
-C
-      End Subroutine Agrif_TabpointsnD
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_ClusterGridnD
-C     **************************************************************************
-C      
-      Subroutine Agrif_ClusterGridnD(g,coarsegrid)
-C
-CCC   Description:
-CCC   Clustering on the grid pointed by g.
-C
-CC    Method:
-CC            
-C
-C     Declarations:
-C
-C     Pointer arguments
-      TYPE(AGRIF_grid)     ,pointer  :: g          ! Pointer on the current grid
-      TYPE(AGRIF_rectangle),pointer  :: coarsegrid
-C
-C     Local variables      
-      TYPE(Agrif_rectangle) :: newrect
-      TYPE(Agrif_Variable)  :: newflag
-C
-      INTEGER               :: i,j,k
-      INTEGER ,DIMENSION(3) :: sx
-      INTEGER               :: bufferwidth,flagpoints
-      INTEGER               :: n1,n2,m1,m2,o1,o2
-      INTEGER               :: iii
-C
-C      
-      bufferwidth = int(Agrif_Minwidth/5.)
-C      
-      do iii = 1 , Agrif_probdim
-         sx(iii) = g % nb(iii) + 1
-      enddo
-C                  
-      if ( Agrif_probdim .EQ. 1 ) then
-         allocate(newflag%iarray1(sx(1)))
-         newflag%iarray1 = 0      
-      endif
-      if ( Agrif_probdim .EQ. 2 ) then
-         allocate(newflag%iarray2(sx(1),sx(2)))
-         newflag%iarray2 = 0      
-      endif
-      if ( Agrif_probdim .EQ. 3 ) then
-         allocate(newflag%iarray3(sx(1),sx(2),sx(3)))
-         newflag%iarray3 = 0      
-      endif
-C
-      flagpoints = 0 
-C      
-      if (bufferwidth>0) then 
-C      
-         if ( Agrif_probdim .EQ. 1 ) then
-            do i = bufferwidth,sx(1)-bufferwidth+1      
-               if (g % tabpoint1D(i) .EQ. 1) then
-                  m1 = i - bufferwidth + 1
-                  m2 = i + bufferwidth - 1                  
-                  flagpoints = flagpoints + 1
-                  newflag%iarray1(m1:m2)=1 
-               endif 
-            enddo    
-         endif
-C
-        if ( Agrif_probdim .EQ. 2 ) then
-           do i = bufferwidth,sx(1)-bufferwidth+1      
-               do j = bufferwidth,sx(2)-bufferwidth+1
-                  if (g % tabpoint2D(i,j) .EQ. 1) then
-                     n1 = j - bufferwidth + 1
-                     n2 = j + bufferwidth - 1
-                     m1 = i - bufferwidth + 1
-                     m2 = i + bufferwidth - 1                  
-                     flagpoints = flagpoints + 1
-                     newflag%iarray2(m1:m2,n1:n2)=1 
-                  endif  
-               enddo    
-            enddo
-         endif
-C
-        if ( Agrif_probdim .EQ. 3 ) then
-            do i = bufferwidth,sx(1)-bufferwidth+1      
-               do j = bufferwidth,sx(2)-bufferwidth+1
-                  do k = bufferwidth,sx(3)-bufferwidth+1
-                     if (g % tabpoint3D(i,j,k) .EQ. 1) then
-                        o1 = k - bufferwidth + 1
-                        o2 = k + bufferwidth - 1
-                        n1 = j - bufferwidth + 1
-                        n2 = j + bufferwidth - 1
-                        m1 = i - bufferwidth + 1
-                        m2 = i + bufferwidth - 1                  
-                        flagpoints = flagpoints + 1
-                        newflag%iarray3(m1:m2,n1:n2,o1:o2)=1 
-                     endif 
-                  enddo  
-               enddo    
-            enddo
-        endif
-      else
-          flagpoints = 1       
-C
-          if ( Agrif_probdim .EQ. 1 ) then
-          newflag%iarray1 = g % tabpoint1D
-          endif
-          if ( Agrif_probdim .EQ. 2 ) then
-          newflag%iarray2 = g % tabpoint2D
-          endif
-          if ( Agrif_probdim .EQ. 3 ) then
-          newflag%iarray3 = g % tabpoint3D
-          endif
-      endif
-C       
-      if (flagpoints .EQ. 0) then       
-          if ( Agrif_probdim .EQ. 1 ) deallocate(newflag%iarray1) 
-          if ( Agrif_probdim .EQ. 2 ) deallocate(newflag%iarray2) 
-          if ( Agrif_probdim .EQ. 3 ) deallocate(newflag%iarray3) 
-          Return 
-      endif       
-C      
-      do iii = 1 , Agrif_probdim
-         newrect % imin(iii) = 1
-         newrect % imax(iii) = sx(iii)
-      enddo
-C      
-      Call Agrif_Clusternd(newflag,
-     &                     coarsegrid%childgrids,newrect) 
-C      
-      if ( Agrif_probdim .EQ. 1 ) deallocate(newflag%iarray1)
-      if ( Agrif_probdim .EQ. 2 ) deallocate(newflag%iarray2)
-      if ( Agrif_probdim .EQ. 3 ) deallocate(newflag%iarray3)
-C  
-C    
-      End Subroutine Agrif_ClusterGridnD
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_ClusternD
-C     **************************************************************************
-C
-      Recursive subroutine Agrif_Clusternd(flag,boxlib,oldB) 
-C
-CCC   Description:
-CCC   Clustering on the grid pointed by oldB.
-C
-CC    Method:
-CC            
-C
-C     Declarations:
-C
-C     Arguments  
-      TYPE(Agrif_rectangle) ::  oldB    
-      TYPE(Agrif_Variable)  :: flag
-c      INTEGER,DIMENSION(oldB%imin(1):oldB%imax(1),
-c     &                  oldB%imin(2):oldB%imax(2)) :: flag
-      TYPE(Agrif_lrectangle),pointer :: boxlib      
-C
-C     Local variables      
-      TYPE(Agrif_lrectangle),pointer :: tempbox,parcbox,parcbox2       
-      TYPE(Agrif_rectangle) :: newB,newB2
-      INTEGER :: i,j,k,iii
-      INTEGER,DIMENSION(:),allocatable :: i_sig 
-      INTEGER,DIMENSION(:),allocatable :: j_sig       
-      INTEGER,DIMENSION(:),allocatable :: k_sig       
-      INTEGER,DIMENSION(3) :: ipu,ipl
-      INTEGER,DIMENSION(3) :: istr,islice
-      REAL :: cureff
-      REAL :: neweff
-      INTEGER :: ValMax,ValSum,TailleTab
-      INTEGER :: nbpoints,nbpointsflag  
-      LOGICAL :: test
-C          
-      allocate(i_sig(oldB%imin(1):oldB%imax(1)))
-      if ( Agrif_probdim .GE. 2 ) 
-     & allocate(j_sig(oldB%imin(2):oldB%imax(2)))
-      if ( Agrif_probdim .EQ. 3 ) 
-     & allocate(k_sig(oldB%imin(3):oldB%imax(3)))
-C
-      test = .FALSE.
-      do iii = 1 , Agrif_probdim
-         test = test .OR. ( (oldB%imax(iii)-oldB%imin(iii)+1) 
-     &                    .LT. Agrif_Minwidth)
-      enddo
-      if ( test ) Return
-C     
-      if ( Agrif_probdim .EQ. 1 ) i_sig = flag%iarray1
-      if ( Agrif_probdim .EQ. 2 ) then
-         do i = oldB%imin(1),oldB%imax(1)
-           i_sig(i) = SUM(flag%iarray2(i,
-     &                            oldB%imin(2):oldB%imax(2)))
-         enddo
-         do j = oldB%imin(2),oldB%imax(2)
-           j_sig(j) = SUM(flag%iarray2(
-     &                            oldB%imin(1):oldB%imax(1),j))
-         enddo      
-      endif
-      if ( Agrif_probdim .EQ. 3 ) then
-         do i = oldB%imin(1),oldB%imax(1)
-            i_sig(i) = SUM(flag%iarray3(i,
-     &                            oldB%imin(2):oldB%imax(2),
-     &                            oldB%imin(3):oldB%imax(3)))
-         enddo
-         do j = oldB%imin(2),oldB%imax(2)
-            j_sig(j) = SUM(flag%iarray3(
-     &                          oldB%imin(1):oldB%imax(1),j,
-     &                          oldB%imin(3):oldB%imax(3)))
-         enddo
-         do k = oldB%imin(3),oldB%imax(3)
-            k_sig(k) = SUM(flag%iarray3(
-     &                          oldB%imin(1):oldB%imax(1),
-     &                          oldB%imin(2):oldB%imax(2),k))
-         enddo      
-      endif
-C                    
-      do iii = 1 , Agrif_probdim
-         ipl(iii) = oldB%imin(iii)
-         ipu(iii) = oldB%imax(iii)
-      enddo
-C           
-      Call Agrif_Clusterprune(i_sig,ipl(1),ipu(1)) 
-      if ( Agrif_probdim .GE. 2 ) 
-     &   Call Agrif_Clusterprune(j_sig,ipl(2),ipu(2))      
-      if ( Agrif_probdim .EQ. 3 ) 
-     &   Call Agrif_Clusterprune(k_sig,ipl(3),ipu(3))      
-C     
-      test = .TRUE.
-      do iii = 1 , Agrif_probdim
-         test = test .AND. (ipl(iii).EQ.oldB%imin(iii))
-         test = test .AND. (ipu(iii).EQ.oldB%imax(iii))
-      enddo
-      
-      if (.NOT. test) then 
-          do iii = 1 , Agrif_probdim
-             newB%imin(iii) = ipl(iii)
-             newB%imax(iii) = ipu(iii)
-          enddo
-C        
-          if ( Agrif_probdim .EQ. 1 ) 
-     &       nbpoints = SUM(flag%iarray1(newB%imin(1):newB%imax(1)))   
-          if ( Agrif_probdim .EQ. 2 ) 
-     &       nbpoints = SUM(flag%iarray2(newB%imin(1):newB%imax(1),
-     &                           newB%imin(2):newB%imax(2)))   
-          if ( Agrif_probdim .EQ. 3 ) 
-     &       nbpoints = SUM(flag%iarray3(newB%imin(1):newB%imax(1),
-     &                           newB%imin(2):newB%imax(2),   
-     &                           newB%imin(3):newB%imax(3)))
-C   
-          if ( Agrif_probdim .EQ. 1 ) 
-     &       TailleTab = newB%imax(1)-newB%imin(1)+1
-          if ( Agrif_probdim .EQ. 2 ) 
-     &       TailleTab = (newB%imax(1)-newB%imin(1)+1)*
-     &                   (newB%imax(2)-newB%imin(2)+1)
-          if ( Agrif_probdim .EQ. 3 ) 
-     &       TailleTab = (newB%imax(1)-newB%imin(1)+1)*
-     &                   (newB%imax(2)-newB%imin(2)+1)*
-     &                   (newB%imax(3)-newB%imin(3)+1)
-C
-          neweff = REAL(nbpoints)/TailleTab
-C     
-          if (nbpoints.GT.0) then
-C        
-              if ((neweff .GT .Agrif_efficiency)) then
-                  Call Agrif_Add_Rectangle(newB,boxlib)
-                  Return
-              else
-C            
-                  tempbox => boxlib
-                  newB2 = newB
-                  Call Agrif_Clusternd(flag,
-     &                      boxlib,newB)
-C     
-C                 Compute new efficiency
-C
-                  cureff = neweff
-                  parcbox2 => boxlib
-                  nbpoints = 0
-                  nbpointsflag = 0
-C
-                  do While (associated(parcbox2))
-                    if (associated(parcbox2,tempbox)) Exit
-                    newB = parcbox2%r
-C
-                    if ( Agrif_probdim .EQ. 1 ) Valsum = 
-     &                                 SUM(flag%iarray1(
-     &                                 newB%imin(1):newB%imax(1)))
-                    if ( Agrif_probdim .EQ. 2 ) Valsum = 
-     &                                 SUM(flag%iarray2(
-     &                                 newB%imin(1):newB%imax(1),
-     &                                 newB%imin(2):newB%imax(2)))
-                    if ( Agrif_probdim .EQ. 3 ) Valsum = 
-     &                                 SUM(flag%iarray3(
-     &                                 newB%imin(1):newB%imax(1),
-     &                                 newB%imin(2):newB%imax(2),
-     &                                 newB%imin(3):newB%imax(3)))
-C
-                    nbpointsflag = nbpointsflag + ValSum
-                    if ( Agrif_probdim .EQ. 1 ) 
-     &                 TailleTab = newB%imax(1)-newB%imin(1)+1
-                    if ( Agrif_probdim .EQ. 2 ) 
-     &                 TailleTab = (newB%imax(1)-newB%imin(1)+1)*
-     &                             (newB%imax(2)-newB%imin(2)+1)
-                    if ( Agrif_probdim .EQ. 3 ) 
-     &                 TailleTab = (newB%imax(1)-newB%imin(1)+1)*
-     &                             (newB%imax(2)-newB%imin(2)+1)*
-     &                             (newB%imax(3)-newB%imin(3)+1)
-                    nbpoints = nbpoints + TailleTab
-                    parcbox2 => parcbox2%next  
-                  enddo  
-C coefficient 1.05 avant 1.15 possibilité de laisser choix à l utilisateur
-                  if  (REAL(nbpointsflag)/REAL(nbpoints)
-     &                 .LT.(1.0001*cureff)) then
-                      parcbox2 => boxlib            
-                      do While (associated(parcbox2))
-                        if (associated(parcbox2,tempbox)) Exit
-                        deallocate(parcbox2%r)
-                        parcbox2 => parcbox2%next             
-                      enddo      
-                      boxlib => tempbox
-                      Call Agrif_Add_Rectangle(newB2,boxlib)
-                      Return
-                  endif
-              endif         
-          endif
-          Return
-      endif 
-C       
-      do iii = 1 , Agrif_Probdim
-         istr(iii) = oldB%imax(iii)
-         islice(iii) = oldB%imin(iii)
-      enddo     
-C      
-      Call Agrif_Clusterslice(i_sig,islice(1),istr(1)) 
-      if ( Agrif_probdim .GE. 2 ) 
-     & Call Agrif_Clusterslice(j_sig,islice(2),istr(2)) 
-      if ( Agrif_probdim .EQ. 3 ) 
-     & Call Agrif_Clusterslice(k_sig,islice(3),istr(3)) 
-C      
-      ValSum = 0
-      do iii = 1 , Agrif_Probdim
-         Valsum = valSum + islice(iii)
-      enddo
-C      
-      if ( Valsum .EQ. -Agrif_Probdim ) then 
-          Call Agrif_Add_Rectangle(oldB,boxlib) 
-          Return 
-      endif 
-C       
-      nullify(tempbox)
-      tempbox => boxlib
-      if ( Agrif_probdim .EQ. 1 ) 
-     &      cureff  = oldB%imax(1)-oldB%imin(1)+1
-      if ( Agrif_probdim .EQ. 2 ) 
-     &      cureff  = (oldB%imax(1)-oldB%imin(1)+1)*
-     &                (oldB%imax(2)-oldB%imin(2)+1)
-      if ( Agrif_probdim .EQ. 3 ) 
-     &       cureff = (oldB%imax(1)-oldB%imin(1)+1)*
-     &                (oldB%imax(2)-oldB%imin(2)+1)*
-     &                (oldB%imax(3)-oldB%imin(3)+1)
-      Nullify(parcbox)
-C 
-      do iii = 1 , Agrif_Probdim
-          newB%imax(iii) = oldB%imax(iii)            
-          newB%imin(iii) = oldB%imin(iii)
-      enddo     
-C
-      ValMax = 0
-      do iii = 1 , Agrif_Probdim
-         ValMax = Max(ValMax,istr(iii))
-      enddo
-C
-      if (istr(1) .EQ. ValMax ) then
-          newB%imax(1) = islice(1)
-          Call Agrif_Add_Rectangle(newB,parcbox)                   
-          newB%imin(1) = islice(1)+1
-          newB%imax(1) = oldB%imax(1)
-          Call Agrif_Add_Rectangle(newB,parcbox)
-      elseif ( Agrif_probdim .GE. 2 ) then
-         if (istr(2) .EQ. ValMax ) then
-            newB%imax(2) = islice(2)
-            Call Agrif_Add_Rectangle(newB,parcbox)
-            newB%imin(2) = islice(2)+1
-            newB%imax(2) = oldB%imax(2)
-            Call Agrif_Add_Rectangle(newB,parcbox)
-         elseif ( Agrif_probdim .EQ. 3 ) then
-            newB%imax(3) = islice(3)
-            Call Agrif_Add_Rectangle(newB,parcbox)
-            newB%imin(3) = islice(3)+1
-            newB%imax(3) = oldB%imax(3)
-            Call Agrif_Add_Rectangle(newB,parcbox)
-         endif
-      endif
-C      
-      do While (associated(parcbox))
-        newB = parcbox%r            
-C
-        if ( Agrif_probdim .EQ. 1 ) nbpoints = 
-     &                                 SUM(flag%iarray1(
-     &                                 newB%imin(1):newB%imax(1)))
-        if ( Agrif_probdim .EQ. 2 ) nbpoints = 
-     &                                 SUM(flag%iarray2(
-     &                                 newB%imin(1):newB%imax(1),
-     &                                 newB%imin(2):newB%imax(2)))
-        if ( Agrif_probdim .EQ. 3 ) nbpoints = 
-     &                                 SUM(flag%iarray3(
-     &                                 newB%imin(1):newB%imax(1),
-     &                                 newB%imin(2):newB%imax(2),
-     &                                 newB%imin(3):newB%imax(3)))
-C      
-       if ( Agrif_probdim .EQ. 1 ) 
-     &                 TailleTab = newB%imax(1)-newB%imin(1)+1
-       if ( Agrif_probdim .EQ. 2 ) 
-     &                 TailleTab = (newB%imax(1)-newB%imin(1)+1)*
-     &                             (newB%imax(2)-newB%imin(2)+1)
-       if ( Agrif_probdim .EQ. 3 ) 
-     &                 TailleTab = (newB%imax(1)-newB%imin(1)+1)*
-     &                             (newB%imax(2)-newB%imin(2)+1)*
-     &                             (newB%imax(3)-newB%imin(3)+1)
-
-        neweff = REAL(nbpoints) / TailleTab
-C     
-        if (nbpoints .GT. 0) then
-C      
-            if ((neweff .GT .Agrif_efficiency)) then
-                Call Agrif_Add_Rectangle(newB,boxlib)
-            else
-                tempbox => boxlib
-                newB2 = newB
-                Call Agrif_Clusternd(flag,
-     &                      boxlib,newB)
-C
-C               Compute new efficiency
-C
-                cureff = neweff
-                parcbox2 => boxlib
-                nbpoints = 0
-                nbpointsflag = 0
-C
-                do While (associated(parcbox2))
-                  if (associated(parcbox2,tempbox)) Exit
-                  newB = parcbox2%r
-C
-                  if ( Agrif_probdim .EQ. 1 ) ValSum = 
-     &                                 SUM(flag%iarray1(
-     &                                 newB%imin(1):newB%imax(1)))
-                  if ( Agrif_probdim .EQ. 2 ) ValSum = 
-     &                                 SUM(flag%iarray2(
-     &                                 newB%imin(1):newB%imax(1),
-     &                                 newB%imin(2):newB%imax(2)))
-                  if ( Agrif_probdim .EQ. 3 ) ValSum = 
-     &                                 SUM(flag%iarray3(
-     &                                 newB%imin(1):newB%imax(1),
-     &                                 newB%imin(2):newB%imax(2),
-     &                                 newB%imin(3):newB%imax(3)))
-C
-                  nbpointsflag = nbpointsflag + ValSum
-C
-                    if ( Agrif_probdim .EQ. 1 ) 
-     &                 TailleTab = newB%imax(1)-newB%imin(1)+1
-                    if ( Agrif_probdim .EQ. 2 ) 
-     &                 TailleTab = (newB%imax(1)-newB%imin(1)+1)*
-     &                             (newB%imax(2)-newB%imin(2)+1)
-                    if ( Agrif_probdim .EQ. 3 ) 
-     &                 TailleTab = (newB%imax(1)-newB%imin(1)+1)*
-     &                             (newB%imax(2)-newB%imin(2)+1)*
-     &                             (newB%imax(3)-newB%imin(3)+1)
-
-                  nbpoints = nbpoints + TailleTab
-C              
-                  parcbox2 => parcbox2%next  
-                enddo   
-C            
-                if  (REAL(nbpointsflag)/REAL(nbpoints)
-     &               .LT.(1.15*cureff)) then
-                    parcbox2 => boxlib            
-                    do While (associated(parcbox2))
-                      if (associated(parcbox2,tempbox)) Exit
-                      deallocate(parcbox2%r)
-                      parcbox2 => parcbox2%next             
-                    enddo
-                    boxlib => tempbox
-                    Call Agrif_Add_Rectangle(newB2,boxlib)
-                endif
-            endif
-        endif
-        parcbox => parcbox%next
-      enddo
-C      
-C      
-      Return
-C      
-      End Subroutine Agrif_Clusternd 
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Clusterslice
-C     **************************************************************************
-C                           
-      Subroutine Agrif_Clusterslice(sig,slice,str) 
-C
-C
-CCC   Description:
-CCC   
-C
-CC    Method:
-CC            
-C
-C     Declarations:
-C
-C     Arguments 
-      INTEGER                      :: slice,str
-      INTEGER,DIMENSION(slice:str) :: sig 
-C
-C     Local variables      
-      INTEGER                      :: ideb,ifin
-      INTEGER                      :: i,t,a,di,ts 
-      INTEGER,DIMENSION(slice:str) :: lap 
-C
-C    
-      ideb = slice
-      ifin = str
-C    
-      if (SIZE(sig) <= 2*Agrif_Minwidth) then
-          str = -1 
-          slice = -1 
-          Return
-      endif
-C      
-      t = -1 
-      a = -1 
-C
-      do i = ideb+Agrif_Minwidth-1,ifin-Agrif_Minwidth
-          if (sig(i) .EQ. 0) then
-              if ((i-ideb) < (ifin-i)) then
-                  di = i - ideb
-                else 
-                  di = ifin - i 
-              endif
-C
-              if (di > t) then
-                a = i 
-                t = di 
-              endif
-         endif
-      enddo
-C      
-      if (a .NE. (-1)) then
-          slice = a 
-          str = t 
-          Return
-      endif
-C      
-      t = -1 
-      a = -1 
-C      
-      do i = ideb+1,ifin-1 
-        lap(i) = sig(i+1) + sig(i-1) - 2*sig(i) 
-      enddo
-C      
-      do i = ideb + Agrif_Minwidth-1,ifin-Agrif_Minwidth
-        if ((lap(i+1)*lap(i)) .LE. 0) then
-            ts = ABS(lap(i+1) - lap(i)) 
-            if (ts > t) then
-                t = ts 
-                a = i
-            endif
-       endif
-      enddo
-C      
-      if (a .EQ. (ideb + Agrif_Minwidth - 1)) then
-          a = -1
-          t = -1
-      endif
-C      
-      slice = a 
-      str = t 
-C
-C      
-      End Subroutine Agrif_Clusterslice       
-C
-C
-C    
-C     **************************************************************************
-CCC   Subroutine Agrif_Clusterprune
-C     **************************************************************************
-C      
-      Subroutine Agrif_Clusterprune(sig,pl,pu) 
-C
-C
-CCC   Description:
-CCC   
-C
-CC    Method:
-CC            
-C
-C     Declarations:
-C
-C     Arguments
-      INTEGER                  :: pl,pu 
-      INTEGER,DIMENSION(pl:pu) :: sig
-C
-C     Local variables      
-      INTEGER :: ideb,ifin       
-      INTEGER :: diff,addl,addu,udist,ldist  
-C
-C      
-      ideb = pl
-      ifin = pu
-C      
-      if (SIZE(sig) <= Agrif_Minwidth) then
-          return 
-      endif 
-C       
-      do While ((sig(pl) .EQ. 0) .AND. (pl < ifin)) 
-        pl = pl + 1 
-      enddo 
-C       
-      do While ((sig(pu) .EQ. 0) .AND. (pu > ideb)) 
-        pu = pu - 1 
-      enddo 
-C       
-      if ((pu-pl) < Agrif_Minwidth) then
-          diff = Agrif_Minwidth - (pu - pl + 1) 
-          udist = ifin - pu 
-          ldist = pl - ideb
-          addl = diff / 2 
-          addu = diff - addl 
-          if (addu > udist) then
-              addu = udist 
-              addl = diff - addu 
-          endif
-C         
-          if (addl > ldist) then
-              addl = ldist 
-              addu = diff - addl
-          endif
-C         
-          pu = pu + addu 
-          pl = pl - addl         
-C      
-      endif 
-C       
-C
-      End Subroutine Agrif_Clusterprune
-C
-C
-C              
-C     **************************************************************************
-CCC   Subroutine Agrif_Add_Rectangle 
-C     **************************************************************************
-C        
-      Subroutine Agrif_Add_Rectangle(R,LR)
-C
-CCC   Description:
-CCC   Subroutine to add the Agrif_Rectangle R in a list managed by LR.
-C
-C     Declarations:
-C
-C     Arguments               
-      TYPE(AGRIF_rectangle)           :: R  
-      TYPE(AGRIF_lrectangle), Pointer :: LR
-C
-C     Local variable        
-      TYPE(AGRIF_lrectangle), Pointer :: newrect  
-C
-      INTEGER                         :: iii 
-C
-C        
-      allocate(newrect)
-      allocate(newrect % r)
-C
-      newrect % r = R
-C      
-      do iii = 1 , Agrif_Probdim
-         newrect % r % spaceref(iii) = Agrif_Coeffref(iii)
-         newrect % r % timeref(iii) = Agrif_Coeffreft(iii)
-      enddo
-C              
-      newrect % r % number = -1            
-      Nullify(newrect % r % childgrids)
-      newrect % next => LR  
-      LR => newrect  
-C
-C      
-      End Subroutine Agrif_Add_Rectangle   
-C  
-C
-C  
-C     **************************************************************************
-CCC   Subroutine Agrif_Read_Fix_Grd  
-C     **************************************************************************
-C      
-      Recursive Subroutine Agrif_Read_Fix_Grd(coarsegrid,j,nunit)
-C
-CCC   Description:
-CCC   Subroutine to create the grid hierarchy from the reading of the 
-CCC   AGRIF_FixedGrids.in file.
-C
-CC    Method:
-CC    Recursive subroutine and creation of a first grid hierarchy from the
-CC    reading of the AGRIF_FixedGrids.in file.        
-C
-C     Declarations:
-C
-C     Pointer argument      
-      TYPE(AGRIF_rectangle), Pointer   :: coarsegrid ! Pointer on the first grid
-                                                     ! of the grid hierarchy
-C                                    
-C     Scalar arguments                                    
-      INTEGER                          :: j          ! Number of the new grid
-      INTEGER                          :: nunit      ! unit associated with file
-C      
-C     Local variables      
-      TYPE(AGRIF_rectangle)            :: newrect    ! Pointer on a new grid   
-      TYPE(AGRIF_lrectangle), Pointer  :: parcours   ! Pointer for the recursive
-                                                     !    procedure
-      TYPE(AGRIF_lrectangle), Pointer  :: newlrect
-      TYPE(AGRIF_lrectangle), Pointer  :: end_list       
-      INTEGER                          :: i          ! for each child grid
-      INTEGER                          :: nb_grids   ! Number of child grids
-      INTEGER                          :: iii
-C          
-C
-      Nullify(newrect%childgrids)
-C      
-C     Reading of the number of child grids        
-      read(nunit,*) nb_grids
-C      
-C     coarsegrid%nbgridchild = nb_grids
-C      
-      allocate(end_list)
-C
-      nullify(end_list % r)
-      nullify(end_list % next)
-C      
-      coarsegrid % childgrids => end_list
-C
-C     Reading of imin(1),imax(1),imin(2),imax(2),imin(3),imax(3), and space and
-C        time refinement factors for each child grid.
-C     Creation and addition of the new grid to the grid hierarchy. 
-C
-      do i = 1,nb_grids
-        allocate(newlrect)      
-        newrect % number = j   ! Number of the grid
-C
-        if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
-           if (Agrif_Probdim == 3) then  
-            read(nunit,*) newrect % imin(1), newrect % imax(1),
-     &                    newrect % imin(2), newrect % imax(2),
-     &                    newrect % imin(3), newrect % imax(3),
-     &                    newrect % spaceref(1),newrect % spaceref(2),
-     &                    newrect % spaceref(3),
-     &                    newrect % timeref(1),newrect % timeref(2),
-     &                    newrect % timeref(3)
-           elseif (Agrif_Probdim == 2) then            
-            read(nunit,*) newrect % imin(1),newrect % imax(1),
-     &                  newrect % imin(2),newrect % imax(2),
-     &                    newrect % spaceref(1),newrect % spaceref(2),
-     &                    newrect % timeref(1),newrect % timeref(2)
-           elseif (Agrif_Probdim == 1) then
-            read(nunit,*) newrect % imin(1), newrect % imax(1),
-     &                    newrect % spaceref(1),
-     &                    newrect % timeref(1)
-           endif
-        else
-           if (Agrif_Probdim == 3) then  
-            read(nunit,*) newrect % imin(1), newrect % imax(1),
-     &                    newrect % imin(2), newrect % imax(2),
-     &                    newrect % imin(3), newrect % imax(3),
-     &                    newrect % spaceref(1),newrect % spaceref(2),
-     &                    newrect % spaceref(3),
-     &                    newrect % timeref(1)
-           elseif (Agrif_Probdim == 2) then            
-            read(nunit,*) newrect % imin(1),newrect % imax(1),
-     &                  newrect % imin(2),newrect % imax(2),
-     &                    newrect % spaceref(1),newrect % spaceref(2),
-     &                    newrect % timeref(1)
-           elseif (Agrif_Probdim == 1) then
-            read(nunit,*) newrect % imin(1), newrect % imax(1),
-     &                    newrect % spaceref(1),
-     &                    newrect % timeref(1)
-           endif
-C
-           if ( Agrif_probdim .GE. 2 ) then
-              do iii = 2 , Agrif_probdim
-                 newrect % timeref(iii) = newrect % timeref(1) 
-              enddo
-           endif
-C
-        endif
-C
-C       Addition to the grid hierarchy
-C
-        nullify(newrect % childgrids)
-        j = j + 1
-        Allocate(newlrect%r)
-        newlrect % r = newrect 
-        nullify(newlrect % next)
-        end_list % next => newlrect
-        end_list => end_list % next
-      enddo
-C      
-      coarsegrid % childgrids => coarsegrid % childgrids % next
-      parcours => coarsegrid % childgrids
-C
-C     Recursive operation to create the grid hierarchy branch by branch
-C
-      do while (associated(parcours))
-        call Agrif_Read_Fix_Grd (parcours % r,j,nunit)
-        parcours => parcours % next
-      enddo
-C      
-C
-      End Subroutine Agrif_Read_Fix_Grd        
-C        
-C 
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Create_Grids  
-C     **************************************************************************
-C
-      Recursive Subroutine Agrif_Create_Grids(g,coarsegrid)
-C
-CCC   Description:
-CCC   Subroutine to create the grid hierarchy (g) from the one created with the
-CCC   Agrif_Read_Fix_Grd or Agrif_Cluster_All procedures (coarsegrid).
-C
-CC    Method:
-CC    Recursive subroutine.        
-C
-C     Declarations:
-C
-C     Pointer arguments        
-      TYPE(AGRIF_grid)     , Pointer  :: g          ! Pointer on the root coarse
-                                                    ! grid
-      TYPE(AGRIF_rectangle), Pointer  :: coarsegrid ! Pointer on the root coarse
-                                                    ! grid of the grid hierarchy
-                                                    ! created with the
-                                                    ! Agrif_Read_Fix_Grd
-                                                    ! subroutine
-C
-C     Local pointers
-      TYPE(Agrif_grid)      , Pointer :: newgrid    ! New grid
-      TYPE(Agrif_pgrid)     , Pointer :: newpgrid
-      TYPE(Agrif_pgrid)     , Pointer :: parcours2
-      TYPE(Agrif_lrectangle), Pointer :: parcours
-      TYPE(Agrif_pgrid)     , Pointer :: end_list
-      TYPE(Agrif_pgrid)     , Pointer :: parcours3
-C
-C     Local scalars      
-      LOGICAL                         :: nullliste
-      INTEGER                         :: iii
-      INTEGER                         :: moving_grid_id = 0      
-
-C
-      parcours3 => g % child_grids
-C     
-      if (associated(parcours3)) then
-          do While (associated(parcours3 % next))
-            parcours3 => parcours3 % next
-          enddo
-          end_list => parcours3
-          nullliste=.FALSE.
-        else
-          allocate(end_list)
-          nullify(end_list % gr)
-          nullify(end_list % next)      
-          g % child_grids => end_list 
-          parcours3 => end_list      
-          nullliste=.TRUE.
-      endif
-C      
-      parcours => coarsegrid % childgrids
-C      
-C     Creation of the grid hierarchy from the one created by using the 
-C     Agrif_Read_Fix_Grd subroutine 
-C
-      do while (associated(parcours))
-        allocate(newgrid)        
-        moving_grid_id=moving_grid_id+1
-        newgrid % grid_id = moving_grid_id
-        do iii = 1 , Agrif_Probdim
-           newgrid % spaceref(iii) = parcours % r % spaceref(iii)
-           newgrid % timeref(iii) = parcours % r % timeref(iii)
-        enddo
-C
-        do iii = 1 , Agrif_Probdim
-          newgrid % nb(iii) = (parcours % r % imax(iii) 
-     &                       - parcours % r % imin(iii)) 
-     &                       * parcours % r % spaceref(iii)
-C     
-          newgrid % ix(iii) =  parcours % r % imin(iii)
-C
-          newgrid % Agrif_d(iii) = g % Agrif_d(iii) 
-     &                  / REAL(newgrid % spaceref(iii))
-C
-          newgrid % Agrif_x(iii) = g % Agrif_x(iii) +
-     &      (parcours % r % imin(iii) - 1)* g % Agrif_d(iii)
-C      
-        enddo
-C
-C       Pointer on the parent grid                        
-C
-        newgrid % parent => g      
-
-C       Level of the current grid
-        newgrid % level = newgrid % parent % level + 1
-        if (newgrid % level > Agrif_MaxLevelLoc) then
-          Agrif_MaxLevelLoc = newgrid%level
-        endif
-
-C      
-C       Grid pointed by newgrid is a fixed grid      
-C
-        if (parcours % r % number .GT. 0) then      
-            newgrid % fixed = .true.  
-          else
-            newgrid % fixed = .false.
-        endif
-C
-C       Number of the grid pointed by newgrid
-        newgrid % fixedrank = parcours % r % number
-C           
-C       No time calculation on this grid         
-        newgrid % ngridstep = 0      
-C
-C       Test indicating if the current grid has a common border with the root 
-C       coarse grid in the x direction
-        do iii = 1 , Agrif_Probdim
-           newgrid % NearRootBorder(iii) = .FALSE.
-C        
-           if ((newgrid % parent % NearRootBorder(iii)) .AND. 
-     &         (newgrid % ix(iii) == 1)) then
-               newgrid % NearRootBorder(iii) = .TRUE.
-           endif
-C
-           newgrid % DistantRootBorder(iii) = .FALSE.
-C 
-           if ((newgrid % parent % DistantRootBorder(iii)) .AND. 
-     &         (newgrid % ix(iii) + 
-     &         (newgrid % nb(iii)/newgrid % spaceref(iii))  
-     &          - 1  == newgrid % parent % nb(iii))) then
-               newgrid % DistantRootBorder(iii) = .TRUE.
-           endif
-        enddo
-C
-C       Writing in output files
-C
-        newgrid % oldgrid = .FALSE.      
-C
-C     
-C       Definition of the CHARACTERistics of the variable of the grid pointed by
-C       newgrid 
-        Call Agrif_Create_Var (newgrid)
-C      
-C       Instanciation of the grid pointed by newgrid and its variables
-        Call Agrif_Instance (newgrid)
-C       
-C       Nullify the variable of the grid pointed by newgrid
-C
-C
-C       Addition of this grid to the grid hierarchy 
-C      
-        nullify(newgrid % child_grids)
-        allocate(newpgrid)  
-        newpgrid % gr => newgrid
-        nullify(newpgrid % next)
-        end_list % next => newpgrid
-        end_list => end_list % next               
-        parcours => parcours % next
-C
-C       Updating the total number of fixed grids
-        if (newgrid % fixed) then
-            AGRIF_nbfixedgrids = AGRIF_nbfixedgrids + 1
-        endif
-C                  
-      enddo
-C
-C
-      if (nullliste) then
-          g % child_grids => g % child_grids % next
-          parcours2 => g % child_grids
-          deallocate(parcours3)
-        else
-          parcours2 => parcours3 % next
-      endif
-C      
-      parcours => coarsegrid % childgrids
-C
-C     Recursive call to the subroutine Agrif_Create_Fixed_Grids to create the
-C     grid hierarchy
-C      
-      do while (associated(parcours))
-        Call Agrif_Create_Grids (parcours2 % gr,parcours % r)
-        parcours => parcours % next
-        parcours2 => parcours2 % next
-      enddo 
-C      
-      Return      
-C                  
-      End Subroutine Agrif_Create_Grids
-C
-C      
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Init_Hierarchy  
-C     **************************************************************************
-C
-      Recursive Subroutine Agrif_Init_Hierarchy(g) 
-C
-CCC   Description:
-CCC   Subroutine to initialize all the grids except the root coarse grid (this 
-CCC   one, pointed by AGRIF_mygrid, is initialized by the subroutine 
-CCC   Agrif_Init_Grids defi ned in the module Agrif_Util and called in the main 
-CCC   program ). 
-C
-CC    Method:
-CC    Recursive subroutine.        
-C
-C     Declarations:
-C
-C     Pointer argument      
-      TYPE(AGRIF_grid), Pointer  :: g         ! Pointer on the root coarse grid 
-C      
-C     Local variables      
-      TYPE(AGRIF_pgrid), Pointer :: parcours  ! Pointer for the recursive call
-      LOGICAL                    :: Init_Hierarchy
-C      
-C
-      parcours=>g%child_grids
-C      
-      do while (associated(parcours))
-        Init_Hierarchy = .false.
-        if ( AGRIF_USE_FIXED_GRIDS .EQ. 1 .OR. 
-     &       AGRIF_USE_ONLY_FIXED_GRIDS .EQ. 1 ) then
-           if ((parcours%gr%fixed) 
-     &         .AND. (Agrif_mygrid%ngridstep == 0)) then
-              Init_Hierarchy = .true.
-           endif      
-       endif
-C
-       if (.NOT. parcours%gr%fixed) Init_Hierarchy = .true.
-       if (parcours % gr % oldgrid) Init_Hierarchy = .false.
-C
-       if (Init_Hierarchy) then 
-C
-C           Instanciation of the grid pointed by parcours%gr and its variables 
-            Call Agrif_Instance (parcours % gr)
-C    
-C           Allocation of the arrays containing values of the variables of the
-C           grid pointed by parcours%gr      
-C      
-            Call Agrif_Allocation (parcours % gr)   
-C            
-            Call Agrif_initialisations(parcours % gr)              
-C       
-            Call Agrif_Instance(parcours % gr)
-C
-            if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
-              Call Agrif_Allocate_Restore (parcours % gr)
-            endif
-C
-            if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
-C              Initialization by copy of the grids created by clustering 
-               Call AGRIF_CopyFromold_All (parcours%gr,
-     &                                     Agrif_oldmygrid)
-            endif
-C
-C           Initialization by interpolation 
-C           (this routine is written by the user) 
-            Call Agrif_InitValues()
-C
-            if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
-               Call Agrif_Free_Restore (parcours % gr)
-            endif
-C
-       endif                                  
-       parcours => parcours % next 
-C         
-      enddo
-C
-      parcours => g % child_grids
-C      
-C     Recursive operation to initialize all the grids
-      do while (associated(parcours))
-        Call Agrif_Init_Hierarchy (parcours%gr)
-        parcours => parcours%next
-      enddo
-C      
-      End Subroutine Agrif_Init_Hierarchy 
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Allocate_Restore  
-C     **************************************************************************
-C
-      Subroutine Agrif_Allocate_Restore(Agrif_Gr)
-C      
-C      
-C     Modules used:
-C
-      TYPE(AGRIF_grid), Pointer  :: Agrif_Gr   ! Pointer on the root coarse grid
-C     
-      INTEGER                    :: i
-C
-        do i = 1 , Agrif_NbVariables
-            if ( Agrif_Mygrid%tabvars(i)%var % restaure ) then
-            if ( Agrif_Gr%tabvars(i)%var % nbdim .EQ. 1 ) then    
-            Allocate( Agrif_Gr%tabvars(i)%var%  
-     &    Restore1D(lbound(Agrif_Gr%tabvars(i)%var%array1,1) 
-     &    :ubound(Agrif_Gr%tabvars(i)%var%array1,1))) 
-            Agrif_Gr%tabvars(i)%var%Restore1D = 0
-C
-            endif
-            if ( Agrif_Gr%tabvars(i)%var % nbdim .EQ. 2 ) then
-            Allocate( Agrif_Gr%tabvars(i)%var%Restore2D(  
-     &      lbound(Agrif_Gr%tabvars(i)%var%array2,1):         
-     &      ubound(Agrif_Gr%tabvars(i)%var%array2,1),         
-     &      lbound(Agrif_Gr%tabvars(i)%var%array2,2)          
-     &      :ubound(Agrif_Gr%tabvars(i)%var%array2,2)))         
-            Agrif_Gr%tabvars(i)%var%Restore2D = 0
-C
-            endif
-            if ( Agrif_Mygrid%tabvars(i)%var % nbdim .EQ. 3 ) then
-C     
-            Allocate( Agrif_Gr%tabvars(i)%var%Restore3D( 
-     &      lbound(Agrif_Gr%tabvars(i)%var%array3,1):        
-     &      ubound(Agrif_Gr%tabvars(i)%var%array3,1),        
-     &      lbound(Agrif_Gr%tabvars(i)%var%array3,2):        
-     &      ubound(Agrif_Gr%tabvars(i)%var%array3,2),        
-     &      lbound(Agrif_Gr%tabvars(i)%var%array3,3):        
-     &      ubound(Agrif_Gr%tabvars(i)%var%array3,3)))  
-            Agrif_Gr%tabvars(i)%var%Restore3D = 0
-            endif
-C 
-            endif
-          enddo
-C
-      Return
-C
-C      
-      End Subroutine Agrif_Allocate_Restore      
-C
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Free_Restore  
-C     **************************************************************************
-C
-      Subroutine Agrif_Free_Restore(Agrif_Gr)
-C
-C      
-C     Pointer argument      
-      TYPE(AGRIF_grid), Pointer  :: Agrif_Gr   ! Pointer on the root coarse grid
-      INTEGER :: i     
-C
-      do i = 1 , Agrif_NbVariables
-         if ( Agrif_Mygrid % tabvars(i) % var % restaure) then
-C  
-            if (associated(Agrif_Gr%tabvars(i)%var%Restore1D)) then
-               Deallocate(Agrif_Gr%tabvars(i)%var%Restore1D)
-            endif
-            if (associated(Agrif_Gr%tabvars(i)%var%Restore2D)) then
-               Deallocate(Agrif_Gr%tabvars(i)%var%Restore2D)
-            endif
-            if (associated(Agrif_Gr%tabvars(i)%var%Restore3D)) then
-               Deallocate(Agrif_Gr%tabvars(i)%var%Restore3D)
-            endif
-            if (associated(Agrif_Gr%tabvars(i)%var%Restore4D)) then
-               Deallocate(Agrif_Gr%tabvars(i)%var%Restore4D)
-            endif
-            if (associated(Agrif_Gr%tabvars(i)%var%Restore5D)) then
-               Deallocate(Agrif_Gr%tabvars(i)%var%Restore5D)
-            endif
-            if (associated(Agrif_Gr%tabvars(i)%var%Restore6D)) then
-               Deallocate(Agrif_Gr%tabvars(i)%var%Restore6D)
-            endif
-C 
-        endif
-      enddo
-C 
-      Return
-C
-C      
-      End Subroutine Agrif_Free_Restore
-C
-C
-C
-      End Module Agrif_Clustering
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcluster.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcluster.F90	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcluster.F90	(revision 6440)
@@ -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: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcurgridfunctions.F
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcurgridfunctions.F	(revision 6439)
+++ 	(revision )
@@ -1,990 +1,0 @@
-!
-! $Id: modcurgridfunctions.F 2715 2011-03-30 15:58:35Z rblod $
-!
-C     AGRIF (Adaptive Grid Refinement In Fortran)
-C
-C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
-C
-C     This program is free software; you can redistribute it and/or modify
-C     it under the terms of the GNU General Public License as published by
-C     the Free Software Foundation; either version 2 of the License, or
-C     (at your option) any later version.
-C
-C     This program is distributed in the hope that it will be useful,
-C     but WITHOUT ANY WARRANTY; without even the implied warranty of
-C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-C     GNU General Public License for more details.
-C
-C     You should have received a copy of the GNU General Public License
-C     along with this program; if not, write to the Free Software
-C     Foundation, Inc., 59 Temple Place-  Suite 330, Boston, MA 02111-1307, USA.
-C
-C
-C
-CCC   Module Agrif_CurgridFunctions      
-C      
-      Module Agrif_CurgridFunctions    
-C  
-CCC   Description:
-CCC   Module to define some procedures concerning the current grid
-C
-C     Modules used: 
-C
-      Use Agrif_Init
-C
-      IMPLICIT NONE
-C
-C
-      Contains
-C     Define procedures contained in this module
-C
-C     **************************************************************************
-CCC   Function Agrif_Rhot
-C     **************************************************************************
-C
-      Function Agrif_Rhot()
-C  
-CCC   Description:
-CCC   Function returning the time refinement factor of the current grid.
-C
-C     Declarations:
-C  
-      
-C
-      REAL :: Agrif_Rhot  ! Result
-C
-C     Local scalar      
-      INTEGER :: res         ! Intermediate result
-      INTEGER :: iii
-C
-C
-      res=1
-C
-      do iii = 1 , Agrif_Probdim
-         res = max(res, AGRIF_Curgrid % timeref(iii))
-      enddo
-C
-      Agrif_Rhot = float(res)
-C
-C
-      End function Agrif_rhot
-C
-C
-C
-C
-C     **************************************************************************
-CCC   Function Agrif_IRhot
-C     **************************************************************************
-C
-      Function Agrif_IRhot()
-C  
-CCC   Description:
-CCC   Function returning the time refinement factor of the current grid.
-C
-C     Declarations:
-C  
-      
-C
-      INTEGER :: Agrif_IRhot  ! Result
-C
-C     Local scalar      
-      INTEGER :: res         ! Intermediate result
-      INTEGER :: iii
-C
-C
-      res=1
-C
-      do iii = 1 , Agrif_Probdim
-         res = max(res, AGRIF_Curgrid % timeref(iii))
-      enddo
-C
-      Agrif_IRhot = res
-C
-C
-      End function Agrif_IRhot
-C
-C
-C
-C     **************************************************************************
-CCC   Function Agrif_Parent_Rhot
-C     **************************************************************************
-C
-      Function Agrif_Parent_Rhot()
-C  
-CCC   Description:
-CCC   Function returning the time refinement factor of the parent grid of the 
-CCC   current grid.
-C
-C     Declarations:
-C  
-      
-C
-      REAL :: Agrif_Parent_Rhot  ! Result
-C
-C     Local scalar      
-      INTEGER :: res         ! Intermediate result
-      INTEGER :: iii
-C
-C
-      res=1
-C
-      do iii = 1 , Agrif_Probdim
-         res = max(res, AGRIF_Curgrid % parent % timeref(iii))
-      enddo
-C
-      Agrif_Parent_Rhot = float(res)
-C
-C
-      End function Agrif_Parent_Rhot      
-C
-C
-C     **************************************************************************
-CCC   Function Agrif_Parent_IRhot
-C     **************************************************************************
-C
-      Function Agrif_Parent_IRhot()
-C  
-CCC   Description:
-CCC   Function returning the time refinement factor of the parent grid of the 
-CCC   current grid.
-C
-C     Declarations:
-C  
-      
-C
-      INTEGER :: Agrif_Parent_IRhot  ! Result
-C
-C     Local scalar      
-      INTEGER :: res         ! Intermediate result
-      INTEGER :: iii
-C
-C
-      res=1
-C
-      do iii = 1 , Agrif_Probdim
-         res = max(res, AGRIF_Curgrid % parent % timeref(iii))
-      enddo
-C
-      Agrif_Parent_IRhot = res
-C
-C
-      End function Agrif_Parent_IRhot      
-C
-C
-C     **************************************************************************
-CCC   Function Agrif_Nbstepint
-C     **************************************************************************
-C
-      Function Agrif_Nbstepint()
-C  
-CCC   Description:
-CCC   Function for the calculation of the coefficients used for the time 
-CCC   interpolation (module Agrif_Boundary).
-C
-C     Declarations:
-C  
-      
-C            
-      INTEGER :: Agrif_nbstepint  ! result
-C
-C
-      Agrif_nbstepint = mod(AGRIF_CURGRID % ngridstep,
-     &                      int(AGRIF_rhot()))
-C
-C
-      End function Agrif_Nbstepint
-C
-C
-C
-CC    **************************************************************************
-CCC   Function Agrif_Parent_Nbstepint
-C     **************************************************************************
-C
-      Function Agrif_Parent_Nbstepint()
-C  
-CCC   Description:
-CCC   Function for the calculation of the coefficients used for the time 
-CCC   interpolation (module Agrif_Boundary).
-C
-C     Declarations:
-C  
-      
-C            
-      INTEGER :: Agrif_Parent_Nbstepint  ! result
-C
-C
-      Agrif_Parent_Nbstepint = mod(AGRIF_CURGRID % parent % ngridstep, 
-     &                             int(AGRIF_Parent_Rhot()))
-C
-C
-      End function Agrif_Parent_Nbstepint
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_InterpNearBorderX
-C     **************************************************************************
-C
-      Subroutine Agrif_InterpNearBorderX()
-C  
-CCC   Description:
-CCC   Subroutine allowing to interpole (in the x direction) on a near border of 
-CCC   the current grid if this one has a common border with the root coarse 
-CCC   grid.   
-C
-C     Declarations:
-C  
-      
-C
-C
-      AGRIF_CURGRID % NearRootBorder(1) = .FALSE.             
-C
-C
-      End Subroutine Agrif_InterpNearBorderX 
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_InterpDistantBorderX
-C     **************************************************************************
-C
-      Subroutine Agrif_InterpDistantBorderX()
-C  
-CCC   Description:
-CCC   Subroutine allowing to interpole (in the x direction) on a distant border 
-CCC   of the current grid if this one has a common border with the root coarse  
-CCC   grid.
-C
-C     Declarations:
-C  
-
-C
-C
-      AGRIF_CURGRID % DistantRootBorder(1) = .FALSE.             
-C
-C
-      End Subroutine Agrif_InterpDistantBorderX                 
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_InterpNearBorderY
-C     **************************************************************************
-C
-      Subroutine Agrif_InterpNearBorderY()
-C  
-CCC   Description:
-CCC   Subroutine allowing to interpole (in the y direction) on a near border of 
-CCC   the current grid if this one has a common border with the root coarse 
-CCC   grid.
-C
-C     Declarations:
-C  
-      
-C
-C
-      AGRIF_CURGRID % NearRootBorder(2) = .FALSE.             
-C
-C
-      End Subroutine Agrif_InterpNearBorderY
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_InterpDistantBorderY
-C     **************************************************************************
-C
-      Subroutine Agrif_InterpDistantBorderY()
-C  
-CCC   Description:
-CCC   Subroutine allowing to interpole (in the y direction) on a distant border 
-CCC   of the current grid if this one has a common border with the root coarse  
-CCC   grid.
-C
-C     Declarations:
-C  
-      
-C
-C
-      AGRIF_CURGRID % DistantRootBorder(2) = .FALSE.             
-C
-C
-      End Subroutine Agrif_InterpDistantBorderY      
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_InterpNearBorderZ
-C     **************************************************************************
-C
-      Subroutine Agrif_InterpNearBorderZ()
-C  
-CCC   Description:
-CCC   Subroutine allowing to interpole (in the z direction) on a near border of 
-CCC   the current grid if this one has a common border with the root coarse 
-CCC   grid.
-C
-C     Declarations:
-C  
-      
-C
-C
-      AGRIF_CURGRID % NearRootBorder(3) = .FALSE.             
-C
-C
-      End Subroutine Agrif_InterpNearBorderZ
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_InterpDistantBorderZ
-C     **************************************************************************
-C
-      Subroutine Agrif_InterpDistantBorderZ()
-C  
-CCC   Description:
-CCC   Subroutine allowing to interpole (in the z direction) on a distant border 
-CCC   of the current grid if this one has a common border with the root coarse  
-CCC   grid.
-C
-C     Declarations:
-C  
-      
-C
-C
-      AGRIF_CURGRID % DistantRootBorder(3) = .FALSE.             
-C
-C
-      End Subroutine Agrif_InterpDistantBorderZ
-C 
-C     **************************************************************************
-CCC   Function Agrif_Parent_Nb_Step
-C     ************************************************************************** 
-C 
-      Function AGRIF_Parent_Nb_Step() 
-C  
-CCC   Description:
-CCC   Function returning the number of time steps of the parent grid of the
-CCC   current grid.
-C
-C     Declarations:
-C    
-      
-C
-      INTEGER :: AGRIF_Parent_Nb_Step ! Result 
-C
-C
-      if (Agrif_Root()) then  
-C     
-          Agrif_Parent_Nb_Step = -1 
-C       
-        else
-C       
-          Agrif_Parent_Nb_Step = Agrif_Curgrid % parent % ngridstep
-C     
-      endif
-C
-C     
-      End function Agrif_Parent_Nb_Step    
-C 
-C
-C 
-C     **************************************************************************
-CCC   Function Agrif_Root
-C     **************************************************************************
-C
-      Function Agrif_Root()
-C     
-CCC   Description:
-CCC   Function indicating if the current grid is or not the root grid.
-C
-C     Declarations:
-C
-      
-C
-      LOGICAL :: Agrif_Root   ! Result
-C    
-C
-      if (AGRIF_CURGRID % fixedrank .EQ. 0) then
-C          
-          Agrif_Root = .TRUE.
-C    
-        else
-C    
-          Agrif_Root = .FALSE.
-C     
-      endif
-C
-C    
-      End function Agrif_Root
-C
-C
-C
-C     **************************************************************************
-CCC   Function Agrif_Parent_Root
-C     **************************************************************************
-C
-      Function Agrif_Parent_Root()
-C     
-CCC   Description:
-CCC   Function indicating if the parent grid of the current grid is or not the 
-CCC   root grid.
-C
-C     Declarations:
-C
-      
-C
-      LOGICAL :: Agrif_Parent_Root   ! Result
-C    
-C
-      if (AGRIF_CURGRID % parent % fixedrank .EQ. 0) then
-C          
-          Agrif_Parent_Root = .TRUE.
-C    
-        else
-C    
-          Agrif_Parent_Root = .FALSE.
-C     
-      endif
-C
-C    
-      End function Agrif_Parent_Root     
-C 
-C
-C 
-C     **************************************************************************
-CCC   Function Agrif_Fixed
-C     **************************************************************************
-C 
-      Function Agrif_Fixed()
-C  
-CCC   Description:
-CCC   Function returning the number of the current grid.
-C
-C     Declarations:
-C   
-      
-C
-      INTEGER Agrif_Fixed   ! Result 
-C 
-C
-      if (Agrif_Curgrid % fixed) then
-C     
-          Agrif_Fixed = Agrif_Curgrid % fixedrank 
-C
-        else
-C     
-         Agrif_Fixed = -1
-C        
-      endif
-C
-C     
-      End function Agrif_Fixed 
-C
-C
-C
-C     **************************************************************************
-CCC   Function Agrif_Parent_Fixed
-C     **************************************************************************
- 
-      Function Agrif_Parent_Fixed()
-C  
-CCC   Description:
-CCC   Function returning the number of the parent grid of the current grid.
-C
-C     Declarations:
-C   
-      
-C
-      INTEGER Agrif_Parent_Fixed   ! Result 
-C 
-C
-      if (Agrif_Curgrid % parent % fixed) then
-C     
-          Agrif_Parent_Fixed = AGRIF_CURGRID % parent % fixedrank 
-C
-        else
-C     
-         Agrif_Parent_Fixed = 0
-C        
-      endif
-C
-C     
-      End function Agrif_Parent_Fixed
-C
-C
-C
-C     **************************************************************************
-CCC   Function Agrif_Is_Fixed
-C     **************************************************************************
- 
-      Function Agrif_Is_Fixed()
-C  
-CCC   Description:
-CCC   Function returning true if the current grid is fixed.
-C
-C     Declarations:
-C   
-      
-C
-      LOGICAL Agrif_Is_Fixed   ! Result 
-C 
-C
-      if (Agrif_Curgrid % fixed) then
-C     
-          Agrif_Is_Fixed = .true.
-C
-        else
-C     
-          Agrif_Is_Fixed = .false.
-C        
-      endif
-C
-C     
-      End function Agrif_Is_Fixed
-C
-C
-C
-C     **************************************************************************
-CCC   Function Agrif_Parent_Is_Fixed
-C     **************************************************************************
- 
-      Function Agrif_Parent_Is_Fixed()
-C  
-CCC   Description:
-CCC   Function returning true if the parent grid of the current grid is fixed.
-C
-C     Declarations:
-C   
-      
-C
-      LOGICAL Agrif_Parent_Is_Fixed   ! Result 
-C 
-C
-      if (Agrif_Curgrid % parent % fixed) then
-C     
-          Agrif_Parent_Is_Fixed = .true.
-C
-        else
-C     
-          Agrif_Parent_Is_Fixed = .false.
-C        
-      endif
-C
-C     
-      End function Agrif_Parent_Is_Fixed            
-C
-C 
-C
-C     **************************************************************************
-CCC   Function AGRIF_CFixed
-C     **************************************************************************
- 
-            Function AGRIF_CFixed()
-C  
-CCC   Description:
-CCC   Function returning the number of the current grid.
-C
-C     Declarations:
-C   
-      
-C
-      CHARACTER(3) AGRIF_CFixed   ! Result 
-C
-C     Local variables      
-      CHARACTER(3) cfixed
-      INTEGER fixed
-C 
-C
-      fixed = Agrif_Fixed()
-C      
-      if(fixed.NE.-1) then
-C
-           if (fixed .LE. 9) then
-C
-               write(cfixed,'(i1)')fixed
-C 
-           else
-C   
-               write(cfixed,'(i2)')fixed
-C      
-           endif
-C
-           AGrif_Cfixed=cfixed
-C      
-      else
-C
-      print*,'Call to AGRIF_CFixed() on a moving grid'
-      stop
-C
-      endif     
-
-      End function AGRIF_CFixed
-C
-C
-C
-C     **************************************************************************
-CCC   Function AGRIF_Parent_CFixed
-C     **************************************************************************
- 
-      Function AGRIF_Parent_CFixed()
-C  
-CCC   Description:
-CCC   Function returning the number of the parent grid of the current grid.
-C
-C     Declarations:
-C   
-      
-C
-      CHARACTER(3) AGRIF_Parent_CFixed   ! Result 
-C
-C     Local variables      
-      CHARACTER(3) cfixed
-      INTEGER fixed
-C 
-C
-      fixed = Agrif_Parent_Fixed()
-C      
-      if(fixed.NE.-1) then
-C
-          if (fixed .LE. 9) then
-C
-              write(cfixed,'(i1)')fixed
-C      
-          else
-C        
-              write(cfixed,'(i2)')fixed
-C      
-          endif
-C
-          AGrif_Parent_Cfixed=cfixed
-C
-      else
-C
-      print*,'Illegal call to AGRIF_Parent_CFixed()'
-      stop     
-C
-      endif
-
-      End function AGRIF_Parent_CFixed      
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_ChildGrid_to_ParentGrid
-C     **************************************************************************
-C
-      Subroutine Agrif_ChildGrid_to_ParentGrid()
-C  
-CCC   Description:
-CCC   Subroutine allowing to make the pointer AGRIF_CURGRID point on the parent
-CCC   grid of the current grid.
-C
-C     Declarations:
-C  
-      
-C
-      
-      Agrif_Curgrid%Parent%save_grid => Agrif_Curgrid
-C
-      Call Agrif_Instance(Agrif_Curgrid%parent)            
-C
-C
-      End Subroutine Agrif_ChildGrid_to_ParentGrid
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_ParentGrid_to_ChildGrid
-C     **************************************************************************
-C
-      Subroutine Agrif_ParentGrid_to_ChildGrid()
-C  
-CCC   Description:
-CCC   Subroutine allowing to make the pointer AGRIF_CURGRID point on the child 
-CCC   grid after having called the Agrif_ChildGrid_to_ParentGrid subroutine.
-C
-C     Declarations:
-C  
-      
-C
-C
-      Call Agrif_Instance(Agrif_Curgrid%save_grid)
-C
-C
-      End Subroutine Agrif_ParentGrid_to_ChildGrid
-C
-C
-C
-C     **************************************************************************
-CCC   Function Agrif_Get_Unit
-C     **************************************************************************
-C
-      Function Agrif_Get_Unit()
-
-CCC   Description : return a unit not connected to any file
-C
-C     Declarations
-C
-      
-C
-      INTEGER Agrif_Get_Unit
-C
-C     Local scalars
-      INTEGER n
-      LOGICAL op
-C
-      INTEGER :: nunit
-      INTEGER :: iii,out,iiimax
-      Logical :: BEXIST
-      INTEGER,DIMENSION(1:1000) :: ForbiddenUnit
-C
-C
-C     Load forbidden Unit if the file Agrif_forbidenUnit exist
-C      
-
-      INQUIRE(FILE='Agrif_forbiddenUnit.txt',EXIST=BEXIST)
-      If (.not. BEXIST) Then
-c          File Agrif_forbiddenUnit.txt not found
-      Else
-           nunit = 777
-           open(nunit,file='Agrif_forbiddenUnit.txt',form='formatted',
-     &          status="old")
-              iii = 1
-              do while ( .TRUE. )
-                 read(nunit,*,END = 99) ForbiddenUnit(iii)
-                 iii = iii + 1
-              enddo
-   99         CONTINUE
-              iiimax = iii
-           close(nunit)
-      endif     
-C 
-      do n = 7,1000
-C 
-        Inquire(Unit=n,Opened=op)
-C
-        out = 0
-        if ( BEXIST .AND. .NOT.op) then
-           do iii = 1 , iiimax
-              if ( n .EQ. ForbiddenUnit(iii) ) out = 1
-           enddo
-        endif
-C
-        if (.NOT.op .AND. out .EQ. 0) exit
-C      
-      enddo
-C
-      Agrif_Get_Unit=n
-C
-C
-      End Function Agrif_Get_Unit
-      
-      Subroutine Agrif_Set_Efficiency(eff)
-      REAL :: eff
-      
-      IF ((eff.LT.0.).OR.(eff.GT.1)) THEN
-      write(*,*)'Error Efficiency should be between 0 and 1'
-      stop
-      ELSE
-      Agrif_efficiency = eff
-      ENDIF
-      End Subroutine Agrif_Set_Efficiency
-      
-      Subroutine Agrif_Set_Regridding(regfreq)
-      INTEGER :: regfreq
-      
-      IF (regfreq.LT.0) THEN
-      write(*,*)'Regridding frequency should be positive'
-      stop
-      ELSE
-      Agrif_regridding = regfreq
-      ENDIF
-      End Subroutine Agrif_Set_Regridding
-C
-C
-C     **************************************************************************
-CCC   subroutine Agrif_Set_coeffref_x
-C     **************************************************************************
-      subroutine Agrif_Set_coeffref_x(coefref)
-
-      integer :: coefref
-
-      if (coefref.LT.0) then
-         write(*,*)'Coefficient of raffinement should be positive'
-         stop
-      else
-         AGRIF_coeffref(1) = coefref
-      endif
-      end subroutine Agrif_Set_coeffref_x
-C
-C     **************************************************************************
-CCC   subroutine Agrif_Set_coeffref_y
-C     **************************************************************************
-      subroutine Agrif_Set_coeffref_y(coefref)
-
-      integer :: coefref
-
-      if (coefref.LT.0) then
-         write(*,*)'Coefficient of raffinement should be positive'
-         stop
-      else
-         AGRIF_coeffref(2) = coefref
-      endif
-      end subroutine Agrif_Set_coeffref_y
-C
-C     **************************************************************************
-CCC   subroutine Agrif_Set_coeffref_z
-C     **************************************************************************
-      subroutine Agrif_Set_coeffref_z(coefref)
-
-      integer :: coefref
-
-      if (coefref.LT.0) then
-         write(*,*)'Coefficient of raffinement should be positive'
-         stop
-      else
-         AGRIF_coeffref(3) = coefref
-      endif
-      end subroutine Agrif_Set_coeffref_z
-C
-C     **************************************************************************
-CCC   subroutine Agrif_Set_coeffreft_x
-C     **************************************************************************
-      subroutine Agrif_Set_coeffreft_x(coefref)
-
-      integer :: coefref
-
-      if (coefref.LT.0) then
-         write(*,*)'Coefficient of time raffinement should be positive'
-         stop
-      else
-         AGRIF_coeffreft(1) = coefref
-      endif
-      end subroutine Agrif_Set_coeffreft_x
-C
-C     **************************************************************************
-CCC   subroutine Agrif_Set_coeffreft_y
-C     **************************************************************************
-      subroutine Agrif_Set_coeffreft_y(coefref)
-
-      integer :: coefref
-
-      if (coefref.LT.0) then
-         write(*,*)'Coefficient of time raffinement should be positive'
-         stop
-      else
-         AGRIF_coeffreft(2) = coefref
-      endif
-      end subroutine Agrif_Set_coeffreft_y
-C
-C     **************************************************************************
-CCC   subroutine Agrif_Set_coeffreft_z
-C     **************************************************************************
-      subroutine Agrif_Set_coeffreft_z(coefref)
-
-      integer :: coefref
-
-      if (coefref.LT.0) then
-         write(*,*)'Coefficient of time raffinement should be positive'
-         stop
-      else
-         AGRIF_coeffreft(3) = coefref
-      endif
-      end subroutine Agrif_Set_coeffreft_z
-C
-C     **************************************************************************
-CCC   subroutine Agrif_Set_Minwidth
-C     **************************************************************************
-      subroutine Agrif_Set_Minwidth(coefminwidth)
-
-      integer :: coefminwidth
-
-      if (coefminwidth.LT.0) then
-         write(*,*)'Coefficient of Minwidth should be positive'
-         stop
-      else
-         Agrif_Minwidth = coefminwidth
-      endif
-      end subroutine Agrif_Set_Minwidth
-C
-C     **************************************************************************
-CCC   subroutine Agrif_Set_Rafmax
-C     **************************************************************************
-      subroutine Agrif_Set_Rafmax(coefrafmax)
-
-      integer :: coefrafmax
-      integer :: i
-      real :: res
-
-      if (coefrafmax.LT.0) then
-         write(*,*)'Coefficient of  should be positive'
-         stop
-      else
-         res = 1.
-         do i = 1 , coefrafmax - 1
-            res = res * FLOAT(AGRIF_coeffref(1))
-         enddo
-         if ( res .EQ. 0 ) res = 1
-         Agrif_Mind(1) = 1. / res
-C
-         res = 1.
-         do i = 1 , coefrafmax - 1
-            res = res * FLOAT(AGRIF_coeffref(2))
-         enddo
-         if ( res .EQ. 0 ) res = 1
-         Agrif_Mind(2) = 1. / res
-C
-         res = 1.
-         do i = 1 , coefrafmax - 1
-            res = res * FLOAT(AGRIF_coeffref(3))
-         enddo
-         if ( res .EQ. 0 ) res = 1
-         Agrif_Mind(3) = 1. / res
-C
-      endif
-      end subroutine Agrif_Set_Rafmax
-C
-C     **************************************************************************
-CCC   subroutine Agrif_Open_File
-C     **************************************************************************
-      subroutine Agrif_Open_File(num_id,name_file)
-
-      integer :: num_id
-      character(*) :: name_file
-
-      num_id = Agrif_Get_Unit()
-      if ( .NOT. Agrif_Root() ) then
-         name_file = TRIM(Agrif_CFixed())//'_'//TRIM(name_file)
-      endif
-
-      end subroutine Agrif_Open_File
-
-C     **************************************************************************
-CCC    subroutine Agrif_Set_MaskMaxSearch
-C     **************************************************************************
-      subroutine Agrif_Set_MaskMaxSearch(mymaxsearch)
-      integer mymaxsearch
-      MaxSearch = mymaxsearch
-      end subroutine Agrif_Set_MaskMaxSearch
-      
-C *****************************************************************
-CCC  subroutine Agrif_Level
-C *****************************************************************
-      Function Agrif_Level()
-      Integer :: Agrif_Level
-     
-      Agrif_Level = Agrif_Curgrid % level
-     
-      End Function Agrif_Level
-      
-C *****************************************************************
-CCC  subroutine Agrif_MaxLevel
-C *****************************************************************
-      Function Agrif_MaxLevel()
-      Integer :: Agrif_MaxLevel
-     
-      Agrif_MaxLevel = Agrif_MaxLevelLoc
-     
-      End Function Agrif_MaxLevel      
-
-      End Module Agrif_CurgridFunctions 
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcurgridfunctions.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcurgridfunctions.F90	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcurgridfunctions.F90	(revision 6440)
@@ -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: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modflux.F
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modflux.F	(revision 6439)
+++ 	(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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modgrids.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modgrids.F90	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modgrids.F90	(revision 6440)
@@ -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: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinit.F
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinit.F	(revision 6439)
+++ 	(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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinit.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinit.F90	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinit.F90	(revision 6440)
@@ -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: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinitvars.F
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinitvars.F	(revision 6439)
+++ 	(revision )
@@ -1,125 +1,0 @@
-!
-! $Id: modinitvars.F 2528 2010-12-27 17:33:53Z rblod $
-!
-C     Agrif (Adaptive Grid Refinement In Fortran)
-C
-C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
-C
-C     This program is free software; you can redistribute it and/or modify
-C     it under the terms of the GNU General Public License as published by
-C     the Free Software Foundation; either version 2 of the License, or
-C     (at your option) any later version.
-C
-C     This program is distributed in the hope that it will be useful,
-C     but WITHOUT ANY WARRANTY; without even the implied warranty of
-C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-C     GNU General Public License for more details.
-C
-C     You should have received a copy of the GNU General Public License
-C     along with this program; if not, write to the Free Software
-C     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-C
-C
-C
-CCC   Module Agrif_Init_Vars
-C
-      Module Agrif_Init_Vars
-C
-CCC   Description:
-CCC   Initialization of the variables of the current grid.
-C
-C     Modules used: 
-C      
-      Use Agrif_Types
-      Use Agrif_link
-C   
-      IMPLICIT NONE
-C
-      Contains
-C     Defininition of the procedures contained in this module 
-C  
-C 
-C     **************************************************************************
-CCC   Subroutine Agrif_Create_var 
-C     **************************************************************************
-C  
-      Subroutine Agrif_Create_Var(Agrif_Gr)
-C
-CCC   Description:
-CCC   Allocation of the field "var" of the grid variables.
-CCC   Fields "root_var", "nbdim" and "parent_var" of the grid variables.
-CCC   Array "tabvars" of the current grid. 
-C
-CC    Method:                  
-C 
-C     Declarations:
-C
-      
-C
-C     Pointer argument:
-      TYPE(Agrif_Grid),pointer   :: Agrif_Gr  ! Pointer on the current grid
-      INTEGER :: nb
-C
-C     Array "tabvars" of the current grid. 
-C
-      Allocate(Agrif_Gr % tabvars(Agrif_NbVariables))
-C      
-      do nb = 1, Agrif_NbVariables
-        Allocate(Agrif_Gr % tabvars(nb) % var)
-      enddo
-
-C     Fields "root_var", "nbdim" and "parent_var" of the grid variables.     
-      if (Agrif_Gr % fixedrank .NE.0) then
-         do nb = 1, Agrif_NbVariables     
-            Agrif_Gr % tabvars(nb) % parent_var => 
-     &      Agrif_Gr % parent %tabvars(nb)
-            Agrif_Gr % tabvars(nb) % var % nbdim =
-     &      Agrif_Mygrid % tabvars(nb) % var % nbdim
-            Agrif_Gr % tabvars(nb) % var % root_var =>
-     &      Agrif_Mygrid % tabvars(nb) % var          
-         enddo
-      endif
-C           
-      End Subroutine Agrif_Create_Var
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_CreateVar
-C     **************************************************************************
-C 
-      Subroutine Agrif_CreateVar(Agrif_Gr)            
-C
-CCC   Description:
-CCC   This subroutine allows to make a link between Mygrid and the current grid 
-C
-C     Modules used:
-C      
-C
-C     Declarations:
-C      
-C
-C
-C     Arguments      
-C
-      TYPE(Agrif_Grid),pointer   :: Agrif_Gr    ! Pointer on the current grid
-      INTEGER                    :: i           ! Loop
-C
-      if (Agrif_Gr % fixedrank .NE. 0) then
-C  
-         do i = 1 , Agrif_NbVariables 
-            Agrif_Gr % tabvars(i) % parent_var => 
-     &      Agrif_Gr % parent % tabvars(i) 
-            Agrif_Gr % tabvars(i) % var % root_var => 
-     &      Agrif_Mygrid % tabvars(i) % var
-            Agrif_Gr % tabvars(i) % var % nbdim  = 
-     &      Agrif_Gr % parent % tabvars(i) % var % nbdim
-         enddo 
-C	 
-      endif 
-C       
-      End Subroutine Agrif_CreateVar
-C
-C
-C
-      End Module Agrif_Init_Vars
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinitvars.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinitvars.F90	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinitvars.F90	(revision 6440)
@@ -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: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F	(revision 6439)
+++ 	(revision )
@@ -1,2270 +1,0 @@
-!
-! $Id: modinterp.F 2731 2011-04-08 12:05:35Z rblod $
-!
-C     AGRIF (Adaptive Grid Refinement In Fortran)
-C
-C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
-C
-C     This program is free software; you can redistribute it and/or modify
-C     it under the terms of the GNU General Public License as published by
-C     the Free Software Foundation; either version 2 of the License, or
-C     (at your option) any later version.
-C
-C     This program is distributed in the hope that it will be useful,
-C     but WITHOUT ANY WARRANTY; without even the implied warranty of
-C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-C     GNU General Public License for more details.
-C
-C     You should have received a copy of the GNU General Public License
-C     along with this program; if not, write to the Free Software
-C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
-C
-C
-C
-CCC   Module Agrif_Interpolation
-C
-      Module Agrif_Interpolation
-C
-CCC   Description:
-CCC   Module to initialize a fine grid from its parent grid, by using a space 
-CCC   interpolation
-C
-C     Modules used:
-C  
-      Use Agrif_Interpbasic
-      Use Agrif_Arrays
-      Use Agrif_Mask 
-      Use Agrif_CurgridFunctions
-#if defined key_mpp_mpi
-      Use Agrif_mpp
-#endif
-C      
-      IMPLICIT NONE
-      logical,  private:: precomputedone(7) = .FALSE.
-C
-      CONTAINS
-C     Define procedures contained in this module        
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_1d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_1d(TypeInterp,parent,child,tab,
-     &    torestore,nbdim,procname)            
-C
-CCC   Description:
-CCC   Subroutine to calculate the boundary conditions of a fine grid for a 1D
-C        grid variable.
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
-                                             !    (linear,lagrange,spline)
-      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
-                                             !    grid
-      LOGICAL :: torestore
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1)
-     &         ), Target :: tab    ! Result
-      External :: procname
-      Optional ::  procname
-C
-C
-      allocate(childtemp % var)  
-C      
-C     Pointer on the root variable
-      childtemp % var % root_var => child % var %root_var
-C      
-C     Number of dimensions of the grid variable
-      childtemp % var % nbdim = nbdim
-C
-C     Tab is the result of the interpolation
-      childtemp % var % parray1 => tab 
-      
-      childtemp % var % lb = child % var % lb
-      childtemp % var % ub = child % var % ub  
-            
-C      
-      if (torestore) then
-C 
-          childtemp % var % parray1 = child % var % array1
-C          
-          childtemp % var % restore1D => child % var % restore1D
-C      
-        else
-C        
-          Nullify(childtemp % var % restore1D)
-C      
-      endif     
-C 
-C     Index indicating (in the Agrif_Interp1D procedure) if a space
-C        interpolation is necessary
-      childtemp % var % interpIndex => child % var % interpIndex       
-      childtemp % var % Interpolationshouldbemade = 
-     &    child % var % Interpolationshouldbemade 
-      childtemp % var % list_interp => child % var% list_interp            
-C      
-      if (present(procname)) then
-      Call Agrif_InterpVariable
-     &     (TypeInterp,parent,childtemp,torestore,procname)
-      else
-      Call Agrif_InterpVariable
-     &     (TypeInterp,parent,childtemp,torestore)
-      endif
-      child % var % list_interp => childtemp % var %list_interp     
-C      
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Interp_1D
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_2d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_2d(TypeInterp,parent,child,tab,
-     &                           torestore,nbdim,procname)            
-C
-CCC   Description:
-CCC   Subroutine to calculate the boundary conditions of a fine grid for a 2D
-C        grid variable.
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
-                                             !    (linear,lagrange,spline)
-      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
-                                             !    grid
-      LOGICAL :: torestore
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1),
-     &         child%var%lb(2):child%var%ub(2)
-     &    ), Target :: tab    ! Result
-      External :: procname
-      Optional ::  procname
-C
-C
-      allocate(childtemp % var)  
-C      
-C     Pointer on the root variable
-      childtemp % var % root_var => child % var %root_var
-C      
-C     Number of dimensions of the grid variable
-      childtemp % var % nbdim = nbdim
-C
-C     Tab is the result of the interpolation
-      childtemp % var % parray2 => tab  
-      
-      childtemp % var % lb = child % var % lb
-      childtemp % var % ub = child % var % ub
-      
-C
-      if (torestore) then      
-C 
-          childtemp % var % parray2 = child % var % array2          
-C 
-          childtemp % var % restore2D => child % var % restore2D        
-C      
-        else
-C        
-          Nullify(childtemp % var % restore2D)
-C      
-      endif       
-C 
-C     Index indicating (in the Agrif_Interp2D procedure) if a space
-C        interpolation is necessary
-      childtemp % var % interpIndex => child % var % interpIndex       
-      childtemp % var % Interpolationshouldbemade = 
-     &    child % var % Interpolationshouldbemade   
-      childtemp % var % list_interp => child % var% list_interp          
-C     
-      if (present(procname)) then
-      Call Agrif_InterpVariable
-     &     (TypeInterp,parent,childtemp,torestore,procname)
-      else
-      Call Agrif_InterpVariable
-     &     (TypeInterp,parent,childtemp,torestore)
-      endif
-
-      child % var % list_interp => childtemp % var %list_interp     
-C      
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Interp_2D
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_3d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_3d(TypeInterp,parent,child,tab,
-     &   torestore,nbdim,procname)            
-C
-CCC   Description:
-CCC   Subroutine to calculate the boundary conditions of a fine grid for a 3D
-C        grid variable.
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
-                                             !    (linear,lagrange,spline)
-      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
-                                             !    grid
-      LOGICAL :: torestore
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1),
-     &         child%var%lb(2):child%var%ub(2),
-     &         child%var%lb(3):child%var%ub(3)
-     &      ), Target :: tab  ! Results
-      External :: procname
-      Optional ::  procname
-C
-C
-      allocate(childtemp % var)  
-C
-C     Pointer on the root variable
-      childtemp % var % root_var => child % var %root_var
-C      
-C     Number of dimensions of the grid variable
-      childtemp % var % nbdim = nbdim  
-C     
-C     Tab is the result of the interpolation 
-      childtemp % var % parray3 => tab 
-      
-      childtemp % var % lb = child % var % lb
-      childtemp % var % ub = child % var % ub        
-C      
-      if (torestore) then
-C     
-          childtemp % var % parray3 = child % var % array3
-C
-          childtemp % var % restore3D => child % var % restore3D
-C      
-        else
-C        
-          Nullify(childtemp % var % restore3D)
-C      
-      endif
-C 
-C     Index indicating (in the Agrif_Interp3D procedure) if a space
-C        interpolation is necessary
-      childtemp % var % interpIndex => child % var % interpIndex    
-      childtemp % var % Interpolationshouldbemade = 
-     &    child % var % Interpolationshouldbemade   
-      childtemp % var % list_interp => child % var% list_interp          
-C     
-
-      if (present(procname)) then
-      Call Agrif_InterpVariable
-     &     (TypeInterp,parent,childtemp,torestore,procname)
-      else
-      Call Agrif_InterpVariable
-     &     (TypeInterp,parent,childtemp,torestore)
-      endif
-
-
-      child % var % list_interp => childtemp % var %list_interp     
-C      
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Interp_3D               
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_4d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_4d(TypeInterp,parent,child,tab,
-     &   torestore,nbdim,procname)            
-C
-CCC   Description:
-CCC   Subroutine to calculate the boundary conditions of a fine grid for a 4D
-C        grid variable.
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
-                                             !    (linear,lagrange,spline)
-      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
-                                             !    grid
-      LOGICAL :: torestore
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1),
-     &         child%var%lb(2):child%var%ub(2),
-     &         child%var%lb(3):child%var%ub(3),
-     &         child%var%lb(4):child%var%ub(4)
-     &      ), Target :: tab  ! Results
-      External :: procname
-      Optional ::  procname
-C
-C
-      allocate(childtemp % var)  
-C
-C     Pointer on the root variable
-      childtemp % var % root_var => child % var %root_var
-C      
-C     Number of dimensions of the grid variable
-      childtemp % var % nbdim = nbdim  
-C      
-C     Tab is the result of the interpolation
-      childtemp % var % parray4 => tab 
-      
-      childtemp % var % lb = child % var % lb
-      childtemp % var % ub = child % var % ub  
-            
-C 
-      if (torestore) then
-C 
-          childtemp % var % parray4 = child % var % array4
-C
-          childtemp % var % restore4D => child % var % restore4D
-C      
-        else
-C        
-          Nullify(childtemp % var % restore4D)
-C      
-      endif        
-C 
-C     Index indicating (in the Agrif_Interp4D procedure) if a space
-C        interpolation is necessary
-      childtemp % var % interpIndex => child % var % interpIndex    
-      childtemp % var % Interpolationshouldbemade = 
-     &    child % var % Interpolationshouldbemade  
-      childtemp % var % list_interp => child % var% list_interp           
-C     
-      if (present(procname)) then
-      Call Agrif_InterpVariable
-     &     (TypeInterp,parent,childtemp,torestore,procname)
-      else
-      Call Agrif_InterpVariable
-     &     (TypeInterp,parent,childtemp,torestore)
-      endif
-
-
-      child % var % list_interp => childtemp % var %list_interp
-C      
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Interp_4D
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_5d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_5d(TypeInterp,parent,child,tab,
-     &   torestore,nbdim,procname)            
-C
-CCC   Description:
-CCC   Subroutine to calculate the boundary conditions of a fine grid for a 5D
-C        grid variable.
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
-                                             !    (linear,lagrange,spline)
-      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
-                                             !    grid
-      LOGICAL :: torestore
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1),
-     &         child%var%lb(2):child%var%ub(2),
-     &         child%var%lb(3):child%var%ub(3),
-     &         child%var%lb(4):child%var%ub(4),
-     &         child%var%lb(5):child%var%ub(5)
-     &      ),  Target :: tab  ! Results
-      External :: procname
-      Optional ::  procname
-C
-C
-      allocate(childtemp % var)  
-C
-C     Pointer on the root variable
-      childtemp % var % root_var => child % var %root_var
-C      
-C     Number of dimensions of the grid variable
-      childtemp % var % nbdim = nbdim  
-C      
-C     Tab is the result of the interpolation
-      childtemp % var % parray5 => tab  
-      
-      childtemp % var % lb = child % var % lb
-      childtemp % var % ub = child % var % ub  
-            
-C      
-      if (torestore) then
-C 
-          childtemp % var % parray5 = child % var % array5
-C
-          childtemp % var % restore5D => child % var % restore5D
-C      
-        else
-C        
-          Nullify(childtemp % var % restore5D)
-C      
-      endif       
-C 
-C     Index indicating (in the Agrif_Interp5D procedure) if a space
-C        interpolation is necessary
-      childtemp % var % interpIndex => child % var % interpIndex    
-      childtemp % var % Interpolationshouldbemade = 
-     &    child % var % Interpolationshouldbemade   
-      childtemp % var % list_interp => child % var% list_interp          
-C      
-      if (present(procname)) then
-      Call Agrif_InterpVariable
-     &     (TypeInterp,parent,childtemp,torestore,procname)
-      else
-      Call Agrif_InterpVariable
-     &     (TypeInterp,parent,childtemp,torestore)
-      endif
-
-     
-      child % var % list_interp => childtemp % var %list_interp
-C      
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Interp_5D
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_6d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_6d(TypeInterp,parent,child,tab,
-     &  torestore,nbdim,procname)            
-C
-CCC   Description:
-CCC   Subroutine to calculate the boundary conditions of a fine grid for a 6D
-C        grid variable.
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
-                                             !    (linear,lagrange,spline)
-      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
-                                             !    grid
-      LOGICAL :: torestore
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1),
-     &         child%var%lb(2):child%var%ub(2),
-     &         child%var%lb(3):child%var%ub(3),
-     &         child%var%lb(4):child%var%ub(4),
-     &         child%var%lb(5):child%var%ub(5),
-     &         child%var%lb(6):child%var%ub(6)
-     &      ),  Target :: tab  ! Results
-      External :: procname
-      Optional ::  procname
-C
-C
-      allocate(childtemp % var)  
-C
-C     Pointer on the root variable
-      childtemp % var % root_var => child % var %root_var
-C      
-C     Number of dimensions of the grid variable
-      childtemp % var % nbdim = nbdim  
-C      
-C     Tab is the result of the interpolation
-      childtemp % var % parray6 => tab  
-      
-      childtemp % var % lb = child % var % lb
-      childtemp % var % ub = child % var % ub  
-            
-C      
-      if (torestore) then
-C 
-          childtemp % var % parray6 = child % var % array6
-C
-          childtemp % var % restore6D => child % var % restore6D
-C      
-        else
-C        
-          Nullify(childtemp % var % restore6D)
-C      
-      endif       
-C 
-C     Index indicating (in the Agrif_Interp6D procedure) if a space
-C        interpolation is necessary
-      childtemp % var % interpIndex => child % var % interpIndex    
-      childtemp % var % Interpolationshouldbemade = 
-     &    child % var % Interpolationshouldbemade  
-     
-      childtemp % var % list_interp => child % var% list_interp           
-C      
-
-      if (present(procname)) then
-      Call Agrif_InterpVariable
-     &     (TypeInterp,parent,childtemp,torestore,procname)
-      else
-      Call Agrif_InterpVariable
-     &     (TypeInterp,parent,childtemp,torestore)
-      endif
-
-
-C      
-      child % var % list_interp => childtemp % var %list_interp
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Interp_6D
-C
-C
-C
-C     **************************************************************************
-C     Subroutine Agrif_InterpVariable    
-C     **************************************************************************
-C   
-      Subroutine Agrif_InterpVariable(TYPEinterp,parent,child,torestore,
-     &            procname)
-C
-CCC   Description:
-CCC   Subroutine to set some arguments of subroutine Agrif_InterpnD, n being the
-CCC   DIMENSION of the grid variable.
-C
-CC    Declarations:
-C      
-c      
-C      
-C
-C     Scalar argument
-      INTEGER,DIMENSION(6) :: TYPEinterp! TYPE of interpolation
-                                        !    (linear,spline,...)
-C     Data TYPE arguments                                   
-      TYPE(AGRIF_PVariable) :: parent   ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child    ! Variable on the child grid
-C
-C     LOGICAL argument      
-      LOGICAL:: torestore               ! Its value is .false., it indicates the
-                                        ! results of the interpolation are    
-                                        ! applied on the whole current grid   
-C
-C     Local scalars      
-      INTEGER               :: nbdim          ! Number of dimensions of the
-                                              !    current grid
-      INTEGER ,DIMENSION(6) :: pttab_child  
-      INTEGER ,DIMENSION(6) :: petab_child      
-      INTEGER ,DIMENSION(6) :: pttab_parent  
-      REAL    ,DIMENSION(6) :: s_child,s_parent
-      REAL    ,DIMENSION(6) :: ds_child,ds_parent
-      External :: procname
-      Optional ::  procname
-
-C
-      Call PreProcessToInterpOrUpdate(parent,child,
-     &             petab_Child(1:nbdim),
-     &             pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
-     &             s_Child(1:nbdim),s_Parent(1:nbdim),
-     &             ds_Child(1:nbdim),ds_Parent(1:nbdim),
-     &             nbdim)
-C
-C
-C     Call to a procedure of interpolation against the number of dimensions of 
-C     the grid variable
-C
-
-      if (present(procname)) then
-      call Agrif_InterpnD
-     &            (TYPEinterp,parent,child,
-     &             pttab_Child(1:nbdim),petab_Child(1:nbdim),
-     &             pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
-     &             s_Child(1:nbdim),s_Parent(1:nbdim),
-     &             ds_Child(1:nbdim),ds_Parent(1:nbdim),
-     &             child,torestore,nbdim,procname)
-      else
-      call Agrif_InterpnD
-     &            (TYPEinterp,parent,child,
-     &             pttab_Child(1:nbdim),petab_Child(1:nbdim),
-     &             pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
-     &             s_Child(1:nbdim),s_Parent(1:nbdim),
-     &             ds_Child(1:nbdim),ds_Parent(1:nbdim),
-     &             child,torestore,nbdim)
-
-      endif
-C
-      Return
-C
-C
-      End subroutine Agrif_InterpVariable       
-C
-C
-C     **************************************************************************
-C     Subroutine Agrif_InterpnD  
-C     **************************************************************************
-C  
-      Subroutine Agrif_InterpnD(TYPEinterp,parent,child,
-     &                          pttab,petab,
-     &                          pttab_Child,pttab_Parent,
-     &                          s_Child,s_Parent,ds_Child,ds_Parent,
-     &                          restore,torestore,nbdim,procname)
-C
-C     Description:
-C     Subroutine to interpolate a nD grid variable from its parent grid,
-C     by using a space interpolation. 
-C
-C     Declarations:
-C
-      
-C
-#ifdef key_mpp_mpi
-C
-        INCLUDE 'mpif.h'
-C
-#endif
-C
-C     Arguments
-      External :: procname
-      Optional :: procname
-      INTEGER                    :: nbdim
-      INTEGER,DIMENSION(6)       :: TYPEinterp         ! TYPE of interpolation
-                                                       !    (linear,...)
-      TYPE(AGRIF_PVARIABLE)      :: parent             ! Variable of the parent
-                                                       !    grid
-      TYPE(AGRIF_PVARIABLE)      :: child              ! Variable of the child
-                                                       !    grid
-      INTEGER,DIMENSION(nbdim)   :: pttab              ! Index of the first
-                                                       !    point inside the
-                                                       !    domain
-      INTEGER,DIMENSION(nbdim)   :: petab              ! Index of the first
-                                                       !    point inside the
-                                                       !    domain
-      INTEGER,DIMENSION(nbdim)   :: pttab_Child        ! Index of the first
-                                                       !    point inside the
-                                                       !    domain for the child
-                                                       !    grid variable
-      INTEGER,DIMENSION(nbdim)   :: pttab_Parent       ! Index of the first
-                                                       !    point inside the
-                                                       !    domain for the
-                                                       !    parent grid variable
-      TYPE(AGRIF_PVARIABLE)      :: restore            ! Indicates points where
-                                                       !    interpolation
-      REAL,DIMENSION(nbdim)      :: s_Child,s_Parent   ! Positions of the parent
-                                                       !    and child grids
-      REAL,DIMENSION(nbdim)      :: ds_Child,ds_Parent ! Space steps of the
-                                                       !    parent and child
-                                                       !    grids
-      LOGICAL                        :: torestore      ! Indicates if the array
-                                                       !    restore is used
-C
-C     Local pointers
-      TYPE(AGRIF_PVARIABLE),SAVE      :: tempP,tempPextend  ! Temporary parent grid variable
-      TYPE(AGRIF_PVARIABLE),SAVE      :: tempC      ! Temporary child grid variable
-C
-C     Local scalars        
-      INTEGER                     :: i,j,k,l,m,n
-      INTEGER,DIMENSION(nbdim)    :: pttruetab,cetruetab
-      INTEGER,DIMENSION(nbdim)    :: indmin,indmax
-      LOGICAL,DIMENSION(nbdim)    :: noraftab
-      REAL   ,DIMENSION(nbdim)    :: s_Child_temp,s_Parent_temp
-      INTEGER,DIMENSION(nbdim)    :: lowerbound,upperbound
-      INTEGER,DIMENSION(nbdim)    :: indminglob,indmaxglob
-      INTEGER,DIMENSION(nbdim,2,2) :: childarray
-      INTEGER,DIMENSION(nbdim,2,2) :: parentarray
-      LOGICAL :: memberin,member
-      TYPE(AGRIF_PVARIABLE),SAVE                      ::  parentvalues
-      LOGICAL :: find_list_interp
-      INTEGER,DIMENSION(nbdim)    :: indminglob2,indmaxglob2      
-C
-#ifdef key_mpp_mpi
-C
-      LOGICAL :: memberout
-      INTEGER,PARAMETER                          :: etiquette = 100
-      INTEGER                                    :: code
-      INTEGER,DIMENSION(nbdim,4)           :: tab3
-      INTEGER,DIMENSION(nbdim,4,0:Agrif_Nbprocs-1) :: tab4
-      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
-      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall
-      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1
-      LOGICAL, DIMENSION(1) :: memberin1
-C
-#endif      
-C     
-
-C   
-C     Boundaries of the current grid where interpolation is done
-
-      IF (Associated(child%var%list_interp)) THEN
-      Call Agrif_Find_list_interp(child%var%list_interp,pttab,petab,
-     &                          pttab_Child,pttab_Parent,nbdim,
-     &                          indmin,indmax,indminglob,
-     &       indmaxglob,indminglob2,indmaxglob2,parentarray,
-     &       pttruetab,cetruetab,member,memberin,find_list_interp
-#if defined key_mpp_mpi
-     &       ,tab4t,memberinall,sendtoproc1,recvfromproc1
-#endif
-     &    )
-      ELSE
-      find_list_interp = .FALSE.
-      ENDIF
-      
-      IF (.not.find_list_interp) THEN
-
-      Call Agrif_nbdim_Get_bound_dimension(child % var,
-     &                               lowerbound,upperbound,nbdim)
-      
-      Call Agrif_Childbounds(nbdim,lowerbound,upperbound,
-     &                                   pttab,petab,
-     &                                   pttruetab,cetruetab,memberin)
-     
-C
-      Call Agrif_Parentbounds(TYPEinterp,nbdim,indminglob,indmaxglob,
-     &                        s_Parent_temp,s_Child_temp,
-     &                        s_Child,ds_Child,
-     &                        s_Parent,ds_Parent,
-     &                        pttab,petab,
-     &                        pttab_Child,pttab_Parent,
-     &                        child%var%root_var%posvar,
-     &                        child % var % root_var % interptab)
-       
-#ifdef key_mpp_mpi
-       IF (memberin) THEN
-        Call Agrif_Parentbounds(TYPEinterp,nbdim,indmin,indmax,
-     &                        s_Parent_temp,s_Child_temp,
-     &                        s_Child,ds_Child,
-     &                        s_Parent,ds_Parent,
-     &                        pttruetab,cetruetab,
-     &                        pttab_Child,pttab_Parent,
-     &                        child%var%root_var%posvar,
-     &                        child % var % root_var % interptab)
-      ENDIF
-       
-      Call Agrif_nbdim_Get_bound_dimension(parent%var,
-     &                              lowerbound,upperbound,nbdim)
-       
-      Call Agrif_ChildGrid_to_ParentGrid()
-C
-      Call Agrif_Childbounds(nbdim,
-     &                       lowerbound,upperbound,
-     &                       indminglob,indmaxglob,
-     &                       indminglob2,indmaxglob2,member)
-
-C
-      IF (member) THEN
-      Call Agrif_GlobtoLocInd2(parentarray,
-     &                     lowerbound,upperbound,
-     &                     indminglob2,indmaxglob2,
-     &                     nbdim,Agrif_Procrank,
-     &                     member)
-       endif
-       
-      Call Agrif_ParentGrid_to_ChildGrid()
-#else
-      parentarray(:,1,1) = indminglob
-      parentarray(:,2,1) = indmaxglob
-      parentarray(:,1,2) = indminglob
-      parentarray(:,2,2) = indmaxglob
-      indmin = indminglob
-      indmax = indmaxglob
-      member = .TRUE.
-#endif
-
-      ELSE
-      
-#if !defined key_mpp_mpi
-      parentarray(:,1,1) = indminglob
-      parentarray(:,2,1) = indmaxglob
-      parentarray(:,1,2) = indminglob
-      parentarray(:,2,2) = indmaxglob
-      indmin = indminglob
-      indmax = indmaxglob
-      member = .TRUE.
-      s_Parent_temp = s_Parent + (indminglob - pttab_Parent)*ds_Parent
-      s_Child_temp = s_Child + (pttab - pttab_Child) * ds_Child
-#else      
-      s_Parent_temp = s_Parent + (indmin - pttab_Parent)*ds_Parent
-      s_Child_temp = s_Child + (pttruetab - pttab_Child) * ds_Child
-#endif      
-           
-      ENDIF
-
-      IF (member) THEN
-      IF (.not.associated(tempP%var)) allocate(tempP%var)
-
-C
-      Call Agrif_nbdim_allocation(tempP%var,
-     &     parentarray(:,1,1),parentarray(:,2,1),nbdim)
-
-      Call Agrif_nbdim_Full_VarEQreal(tempP%var,0.,nbdim)
-
-      IF (present(procname)) THEN
-      Call Agrif_ChildGrid_to_ParentGrid()
-            SELECT CASE (nbdim)
-        CASE(1)
-          CALL procname(tempP%var%array1,
-     &                          parentarray(1,1,2),parentarray(1,2,2))
-        CASE(2)
-          CALL procname(tempP%var%array2,
-     &                          parentarray(1,1,2),parentarray(1,2,2),
-     &                          parentarray(2,1,2),parentarray(2,2,2))
-        CASE(3)
-          CALL procname(tempP%var%array3,
-     &                          parentarray(1,1,2),parentarray(1,2,2),
-     &                          parentarray(2,1,2),parentarray(2,2,2),
-     &                          parentarray(3,1,2),parentarray(3,2,2))
-        CASE(4)
-          CALL procname(tempP%var%array4,
-     &                          parentarray(1,1,2),parentarray(1,2,2),
-     &                          parentarray(2,1,2),parentarray(2,2,2),
-     &                          parentarray(3,1,2),parentarray(3,2,2),
-     &                          parentarray(4,1,2),parentarray(4,2,2))
-        CASE(5)
-          CALL procname(tempP%var%array5,
-     &                          parentarray(1,1,2),parentarray(1,2,2),
-     &                          parentarray(2,1,2),parentarray(2,2,2),
-     &                          parentarray(3,1,2),parentarray(3,2,2),
-     &                          parentarray(4,1,2),parentarray(4,2,2),
-     &                          parentarray(5,1,2),parentarray(5,2,2))
-        CASE(6)
-          CALL procname(tempP%var%array6,
-     &                          parentarray(1,1,2),parentarray(1,2,2),
-     &                          parentarray(2,1,2),parentarray(2,2,2),
-     &                          parentarray(3,1,2),parentarray(3,2,2),
-     &                          parentarray(4,1,2),parentarray(4,2,2),
-     &                          parentarray(5,1,2),parentarray(5,2,2),
-     &                          parentarray(6,1,2),parentarray(6,2,2))
-            END SELECT
-      Call Agrif_ParentGrid_to_ChildGrid()
-      ELSE
-
-      Call Agrif_nbdim_VarEQvar(tempP%var,
-     &        parentarray(:,1,1),parentarray(:,2,1),
-     &        parent%var,parentarray(:,1,2),parentarray(:,2,2),
-     &        nbdim)
-      ENDIF
-            endif
-
-#ifdef key_mpp_mpi
-      if (.not.find_list_interp) then
-      tab3(:,1) = indminglob2(:)
-      tab3(:,2) = indmaxglob2(:)
-      tab3(:,3) = indmin(:)
-      tab3(:,4) = indmax(:)
-C
-C
-      Call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,
-     &                   MPI_INTEGER,MPI_COMM_AGRIF,code)
-
-      IF (.not.associated(tempPextend%var)) Allocate(tempPextend%var)
-
-      DO k=0,Agrif_Nbprocs-1
-       do j=1,4
-         do i=1,nbdim
-         tab4t(i,k,j) = tab4(i,j,k)
-                enddo
-      enddo
-      enddo
-      
-      memberin1(1) = memberin
-      CALL MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall,
-     &                  1,MPI_LOGICAL,MPI_COMM_AGRIF,code)
-
-       Call Get_External_Data_first(tab4t(:,:,1),
-     &            tab4t(:,:,2),
-     &            tab4t(:,:,3),tab4t(:,:,4),nbdim,member,memberin,
-     &            memberinall,sendtoproc1,recvfromproc1,tab4t(:,:,5),
-     & tab4t(:,:,6),tab4t(:,:,7),tab4t(:,:,8))
-          
-      endif     
-           
-!      Call Get_External_Data(tempP,tempPextend,tab4t(:,:,1),
-!     &            tab4t(:,:,2),
-!     &            tab4t(:,:,3),tab4t(:,:,4),nbdim,member,memberin,
-!     &            memberinall)
-     
-      Call ExchangeSameLevel2(sendtoproc1,recvfromproc1,nbdim,
-     &            tab4t(:,:,3),tab4t(:,:,4),tab4t(:,:,5),tab4t(:,:,6),
-     &            tab4t(:,:,7),tab4t(:,:,8),memberin,tempP,
-     &            tempPextend)
-#else
-      tempPextend%var => tempP%var
-#endif
-
-      if (.not.find_list_interp) then
-      Call Agrif_Addto_list_interp(child%var%list_interp,pttab,petab,
-     &                          pttab_Child,pttab_Parent,indmin,indmax,
-     &   indminglob,indmaxglob,indminglob2,indmaxglob2,parentarray,
-     &   pttruetab,cetruetab,member,memberin,nbdim
-#if defined key_mpp_mpi
-     &   ,tab4t,memberinall,sendtoproc1,recvfromproc1
-#endif
-     &    )
-      endif   
-C
-C
-      IF (memberin) THEN
-      IF (.not.associated(tempC%var)) allocate(tempC%var)
-C
-
-      Call Agrif_nbdim_allocation(tempC%var,pttruetab,cetruetab,nbdim)
-
-C
-C
-C     Special values on the parent grid
-      if (Agrif_UseSpecialValue) then
-C
-          noraftab(1:nbdim) =
-     &         child % var % root_var % interptab(1:nbdim) .EQ. 'N'
-C
-          IF (.not.associated(parentvalues%var))
-     &            Allocate(parentvalues%var)
-C
-          Call Agrif_nbdim_allocation
-     &               (parentvalues%var,indmin,indmax,nbdim)
-          Call Agrif_nbdim_Full_VarEQvar
-     &               (parentvalues%var,tempPextend%var,nbdim)
-C
-          Call Agrif_CheckMasknD(tempPextend,
-     &                           parentvalues,
-     &                           indmin(1:nbdim),indmax(1:nbdim),
-     &                           indmin(1:nbdim),indmax(1:nbdim),
-     &                           noraftab(1:nbdim),nbdim)
-C
-          Call Agrif_nbdim_deallocation(parentvalues%var,nbdim)
-C          Deallocate(parentvalues%var)
-C
-C
-      endif      
-
-C
-C
-C     Interpolation of the current grid
-
-      IF (memberin) THEN
-      if ( nbdim .EQ. 1 ) then
-         Call Agrif_Interp_1D_recursive(TypeInterp,
-     &           tempPextend%var%array1,tempC%var%array1,
-     &           indmin,indmax,
-     &           pttruetab,cetruetab,
-     &           s_Child_temp,s_Parent_temp,
-     &           ds_Child,ds_Parent,nbdim)
-      elseif ( nbdim .EQ. 2 ) then
-
-         Call Agrif_Interp_2D_recursive(TypeInterp,
-     &           tempPextend%var%array2,tempC%var%array2,
-     &           indmin,indmax,
-     &           pttruetab,cetruetab,
-     &           s_Child_temp,s_Parent_temp,
-     &           ds_Child,ds_Parent,nbdim)
-      elseif ( nbdim .EQ. 3 ) then
-
-         Call Agrif_Interp_3D_recursive(TypeInterp,
-     &           tempPextend%var%array3,tempC%var%array3,
-     &           indmin,indmax,
-     &           pttruetab,cetruetab,
-     &           s_Child_temp,s_Parent_temp,
-     &           ds_Child,ds_Parent,nbdim)
-      elseif ( nbdim .EQ. 4 ) then
-         Call Agrif_Interp_4D_recursive(TypeInterp,
-     &           tempPextend%var%array4,tempC%var%array4,
-     &           indmin,indmax,
-     &           pttruetab,cetruetab,
-     &           s_Child_temp,s_Parent_temp,
-     &           ds_Child,ds_Parent,nbdim)
-      elseif ( nbdim .EQ. 5 ) then
-         Call Agrif_Interp_5D_recursive(TypeInterp,
-     &           tempPextend%var%array5,tempC%var%array5,
-     &           indmin,indmax,
-     &           pttruetab,cetruetab,
-     &           s_Child_temp,s_Parent_temp,
-     &           ds_Child,ds_Parent,nbdim)
-      elseif ( nbdim .EQ. 6 ) then
-         Call Agrif_Interp_6D_recursive(TypeInterp,
-     &           tempPextend%var%array6,tempC%var%array6,
-     &           indmin,indmax,
-     &           pttruetab,cetruetab,
-     &           s_Child_temp,s_Parent_temp,
-     &           ds_Child,ds_Parent,nbdim)
-       endif
-
-
-C  
-
-      Call Agrif_nbdim_Get_bound_dimension(child % var,
-     &                               lowerbound,upperbound,nbdim)
-
-#ifdef key_mpp_mpi
-      Call Agrif_GlobtoLocInd2(childarray,
-     &                     lowerbound,upperbound,
-     &                     pttruetab,cetruetab,
-     &                     nbdim,Agrif_Procrank,
-     &                     memberout)
-
-#else
-       childarray(:,1,1) = pttruetab
-       childarray(:,2,1) = cetruetab
-       childarray(:,1,2) = pttruetab
-       childarray(:,2,2) = cetruetab
-ccccccccccccccc       memberout = .TRUE.
-#endif
-
-
-C
-C
-C     Special values on the child grid  
-      if (Agrif_UseSpecialValueFineGrid) then
-C
-
-          Call GiveAgrif_SpecialValueToTab_mpi(child%var,tempC%var,
-     &                 childarray,
-     &                 pttruetab,cetruetab,
-     &                 Agrif_SpecialValueFineGrid,nbdim)
-
-C        
-      endif
-      
-      endif
-
-C
-      if (torestore) then
-C
-#ifdef key_mpp_mpi
-C
-        SELECT CASE (nbdim)
-        CASE (1)
-             do i = pttruetab(1),cetruetab(1)         
-ChildarrayAModifier                if (restore%var%restore1D(i) == 0) 
-ChildarrayAModifier     &                child%var%array1(childarray(i,1,2)
-ChildarrayAModifier     &                                 ) = 
-ChildarrayAModifier     &                tempC%var%array1(i)
-             enddo
-        CASE (2)
-             do i = pttruetab(1),cetruetab(1)
-             do j = pttruetab(2),cetruetab(2)
-ChildarrayAModifier                   if (restore%var%restore2D(i,j) == 0) 
-ChildarrayAModifier     &                child%var%array2(childarray(i,1,2),
-ChildarrayAModifier     &                                 childarray(j,2,2)) = 
-ChildarrayAModifier     &                tempC%var%array2(i,j)
-             enddo
-             enddo
-        CASE (3)
-             do i = pttruetab(1),cetruetab(1)
-             do j = pttruetab(2),cetruetab(2)  
-             do k = pttruetab(3),cetruetab(3)
-ChildarrayAModifier                      if (restore%var%restore3D(i,j,k) == 0) 
-ChildarrayAModifier     &                child%var%array3(childarray(i,1,2),
-ChildarrayAModifier     &                                 childarray(j,2,2),
-ChildarrayAModifier     &                                 childarray(k,3,2)) = 
-ChildarrayAModifier     &                tempC%var%array3(i,j,k)
-             enddo
-             enddo
-             enddo
-        CASE (4)
-             do i = pttruetab(1),cetruetab(1)
-             do j = pttruetab(2),cetruetab(2)
-             do k = pttruetab(3),cetruetab(3)
-             do l = pttruetab(4),cetruetab(4)
-ChildarrayAModifier                         if (restore%var%restore4D(i,j,k,l) == 0) 
-ChildarrayAModifier     &                      child%var%array4(childarray(i,1,2),
-ChildarrayAModifier     &                                       childarray(j,2,2),
-ChildarrayAModifier     &                                       childarray(k,3,2),
-ChildarrayAModifier     &                                       childarray(l,4,2)) = 
-ChildarrayAModifier     &                      tempC%var%array4(i,j,k,l)
-             enddo
-             enddo
-             enddo
-             enddo
-        CASE (5)
-             do i = pttruetab(1),cetruetab(1)
-             do j = pttruetab(2),cetruetab(2)
-             do k = pttruetab(3),cetruetab(3)
-             do l = pttruetab(4),cetruetab(4)
-             do m = pttruetab(5),cetruetab(5)
-ChildarrayAModifier              if (restore%var%restore5D(i,j,k,l,m) == 0) 
-ChildarrayAModifier     &                child%var%array5(childarray(i,1,2),
-ChildarrayAModifier     &                                 childarray(j,2,2),
-ChildarrayAModifier     &                                 childarray(k,3,2),
-ChildarrayAModifier     &                                 childarray(l,4,2),
-ChildarrayAModifier     &                                 childarray(m,5,2)) = 
-ChildarrayAModifier     &                tempC%var%array5(i,j,k,l,m)
-             enddo
-             enddo
-             enddo
-             enddo
-             enddo
-        CASE (6)
-             do i = pttruetab(1),cetruetab(1)
-             do j = pttruetab(2),cetruetab(2)
-             do k = pttruetab(3),cetruetab(3)
-             do l = pttruetab(4),cetruetab(4)
-             do m = pttruetab(5),cetruetab(5)
-             do n = pttruetab(6),cetruetab(6)
-ChildarrayAModifier              if (restore%var%restore6D(i,j,k,l,m,n) == 0) 
-ChildarrayAModifier     &                child%var%array6(childarray(i,1,2),
-ChildarrayAModifier     &                                 childarray(j,2,2),
-ChildarrayAModifier     &                                 childarray(k,3,2),
-ChildarrayAModifier     &                                 childarray(l,4,2),
-ChildarrayAModifier     &                                 childarray(m,5,2),
-ChildarrayAModifier     &                                 childarray(n,6,2)) = 
-ChildarrayAModifier     &                tempC%var%array6(i,j,k,l,m,n)
-             enddo
-             enddo
-             enddo
-             enddo
-             enddo
-             enddo
-        END SELECT
-C
-#else
-        SELECT CASE (nbdim)
-        CASE (1)
-           do i = pttruetab(1),cetruetab(1)         
-            if (restore%var%restore1D(i) == 0)
-     &            child % var % parray1(i) = 
-     &            tempC % var % array1(i)    
-          enddo
-        CASE (2)
-           do j = pttruetab(2),cetruetab(2)
-             do i = pttruetab(1),cetruetab(1) 
-              if (restore%var%restore2D(i,j) == 0)     
-     &              child % var % parray2(i,j) = 
-     &              tempC % var % array2(i,j)    
-              enddo
-             enddo
-        CASE (3)
-           do k = pttruetab(3),cetruetab(3)
-           do j = pttruetab(2),cetruetab(2)
-             do i = pttruetab(1),cetruetab(1) 
-              if (restore%var%restore3D(i,j,k) == 0)
-     &                  child % var % parray3(i,j,k) =
-     &                  tempC % var % array3(i,j,k)    
-                  enddo
-              enddo
-             enddo
-        CASE (4)
-           do l = pttruetab(4),cetruetab(4)
-           do k = pttruetab(3),cetruetab(3)
-          do j = pttruetab(2),cetruetab(2)
-             do i = pttruetab(1),cetruetab(1)
-                if (restore%var%restore4D(i,j,k,l) == 0)
-     &                 child % var % parray4(i,j,k,l) = 
-     &                 tempC % var % array4(i,j,k,l)    
-             enddo
-             enddo
-              enddo
-             enddo
-        CASE (5)
-           do m = pttruetab(5),cetruetab(5)
-          do l = pttruetab(4),cetruetab(4)
-         do k = pttruetab(3),cetruetab(3)
-           do j = pttruetab(2),cetruetab(2)
-             do i = pttruetab(1),cetruetab(1)
-                if (restore%var%restore5D(i,j,k,l,m) == 0)
-     &                  child % var % parray5(i,j,k,l,m) = 
-     &                  tempC % var % array5(i,j,k,l,m)    
-             enddo
-             enddo
-                  enddo
-              enddo
-             enddo
-        CASE (6)
-           do n = pttruetab(6),cetruetab(6)
-          do m = pttruetab(5),cetruetab(5)
-          do l = pttruetab(4),cetruetab(4)
-         do k = pttruetab(3),cetruetab(3)
-          do j = pttruetab(2),cetruetab(2)
-             do i = pttruetab(1),cetruetab(1)
-                if (restore%var%restore6D(i,j,k,l,m,n) == 0)
-     &                      child % var % parray6(i,j,k,l,m,n) = 
-     &                      tempC % var % array6(i,j,k,l,m,n)    
-             enddo
-            enddo
-                      enddo
-                  enddo
-              enddo
-             enddo
-        END SELECT
-C
-#endif
-C        
-        else
-C
-C
-          IF (memberin) THEN
-          SELECT CASE (nbdim)
-          CASE (1)
-            child%var%parray1(childarray(1,1,2):childarray(1,2,2)) =
-     &       tempC%var%array1(childarray(1,1,1):childarray(1,2,1))
-          CASE (2)
-            child%var%parray2(childarray(1,1,2):childarray(1,2,2),
-     &                       childarray(2,1,2):childarray(2,2,2)) =
-     &      tempC%var%array2(childarray(1,1,1):childarray(1,2,1),
-     &                       childarray(2,1,1):childarray(2,2,1))
-          CASE (3)
-            child%var%parray3(childarray(1,1,2):childarray(1,2,2),
-     &                       childarray(2,1,2):childarray(2,2,2),
-     &                       childarray(3,1,2):childarray(3,2,2)) =
-     &      tempC%var%array3(childarray(1,1,1):childarray(1,2,1),
-     &                       childarray(2,1,1):childarray(2,2,1),
-     &                       childarray(3,1,1):childarray(3,2,1))
-          CASE (4)
-            child%var%parray4(childarray(1,1,2):childarray(1,2,2),
-     &                       childarray(2,1,2):childarray(2,2,2),
-     &                       childarray(3,1,2):childarray(3,2,2),
-     &                       childarray(4,1,2):childarray(4,2,2)) =
-     &      tempC%var%array4(childarray(1,1,1):childarray(1,2,1),
-     &                       childarray(2,1,1):childarray(2,2,1),
-     &                       childarray(3,1,1):childarray(3,2,1),
-     &                       childarray(4,1,1):childarray(4,2,1))
-          CASE (5)
-            child%var%parray5(childarray(1,1,2):childarray(1,2,2),
-     &                       childarray(2,1,2):childarray(2,2,2),
-     &                       childarray(3,1,2):childarray(3,2,2),
-     &                       childarray(4,1,2):childarray(4,2,2),
-     &                       childarray(5,1,2):childarray(5,2,2)) =
-     &      tempC%var%array5(childarray(1,1,1):childarray(1,2,1),
-     &                       childarray(2,1,1):childarray(2,2,1),
-     &                       childarray(3,1,1):childarray(3,2,1),
-     &                       childarray(4,1,1):childarray(4,2,1),
-     &                       childarray(5,1,1):childarray(5,2,1))
-          CASE (6)
-            child%var%parray6(childarray(1,1,2):childarray(1,2,2),
-     &                       childarray(2,1,2):childarray(2,2,2),
-     &                       childarray(3,1,2):childarray(3,2,2),
-     &                       childarray(4,1,2):childarray(4,2,2),
-     &                       childarray(5,1,2):childarray(5,2,2),
-     &                       childarray(6,1,2):childarray(6,2,2)) =
-     &      tempC%var%array6(childarray(1,1,1):childarray(1,2,1),
-     &                       childarray(2,1,1):childarray(2,2,1),
-     &                       childarray(3,1,1):childarray(3,2,1),
-     &                       childarray(4,1,1):childarray(4,2,1),
-     &                       childarray(5,1,1):childarray(5,2,1),
-     &                       childarray(6,1,1):childarray(6,2,1))
-          END SELECT
-          ENDIF
-C
-C       
-      endif
-
-        Call Agrif_nbdim_deallocation(tempPextend%var,nbdim)
-C        deallocate(tempPextend%var)
-
-      Call Agrif_nbdim_deallocation(tempC%var,nbdim)
-      
-C      Deallocate(tempC % var)
-      ELSE
-      
-C      deallocate(tempPextend%var)
-
-      ENDIF
-C
-C             
-C     Deallocations
-#ifdef key_mpp_mpi        
-      IF (member) THEN
-      Call Agrif_nbdim_deallocation(tempP%var,nbdim)
-C      Deallocate(tempP % var)
-      endif
-#endif
-C
-C
-      
-C
-C
-      End Subroutine Agrif_InterpnD 
-C
-C
-C
-C                  
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Parentbounds
-C     **************************************************************************
-C
-      Subroutine Agrif_Parentbounds(TYPEinterp,nbdim,indmin,indmax,
-     &                              s_Parent_temp,
-     &                              s_Child_temp,s_Child,ds_Child,
-     &                              s_Parent,ds_Parent,
-     &                              pttruetab,cetruetab,pttab_Child,
-     &                              pttab_Parent,posvar,interptab)
-C
-CCC   Description:
-CCC   Subroutine calculating the bounds of the parent grid for the interpolation
-CCC   of the child grid     
-C
-C
-C     Declarations:
-C
-C
-C     Arguments
-      INTEGER :: nbdim
-      INTEGER, DIMENSION(6) :: TypeInterp
-      INTEGER,DIMENSION(nbdim) :: indmin,indmax
-      REAL,DIMENSION(nbdim) :: s_Parent_temp,s_child_temp
-      REAL,DIMENSION(nbdim) :: s_Child,ds_child
-      REAL,DIMENSION(nbdim) :: s_Parent,ds_Parent
-      INTEGER,DIMENSION(nbdim) :: pttruetab,cetruetab
-      INTEGER,DIMENSION(nbdim) :: pttab_Child,pttab_Parent
-      INTEGER,DIMENSION(nbdim) :: posvar
-      CHARACTER(6), DIMENSION(nbdim) :: interptab
-C
-C     Local variables
-      INTEGER :: i
-      REAL,DIMENSION(nbdim) :: dim_newmin,dim_newmax      
-C
-      dim_newmin = s_Child + (pttruetab - pttab_Child) * ds_Child
-      dim_newmax = s_Child + (cetruetab - pttab_Child) * ds_Child
-      
-      DO i = 1,nbdim         
-C     
-        indmin(i) = pttab_Parent(i) + 
-     &         agrif_int((dim_newmin(i)-s_Parent(i))/ds_Parent(i))
-C
-        indmax(i) = pttab_Parent(i) + 
-     &                agrif_ceiling((dim_newmax(i)-
-     &                s_Parent(i))/ds_Parent(i))
-     
-C
-C
-C       Necessary for the Quadratic interpolation
-C  
-
-        IF ((pttruetab(i) == cetruetab(i)) .AND. 
-     &                           (posvar(i) == 1)) THEN
-        ELSEIF (interptab(i) .EQ. 'N') THEN
-        ELSEIF ( TYPEinterp(i) .eq. Agrif_ppm .or.
-     &      TYPEinterp(i) .eq. Agrif_eno  .or.
-     &      TYPEinterp(i) .eq. Agrif_weno) THEN            
-           indmin(i) = indmin(i) - 2  
-           indmax(i) = indmax(i) + 2                  
-        ELSE IF (( TYPEinterp(i) .ne. Agrif_constant )
-     &        .AND.( TYPEinterp(i) .ne. Agrif_linear )) THEN
-           indmin(i) = indmin(i) - 1  
-           indmax(i) = indmax(i) + 1
-        ENDIF
-        
-
-C        
-       ENDDO 
-C
-        s_Parent_temp = s_Parent + (indmin - pttab_Parent) * ds_Parent
-C     
-        s_Child_temp = s_Child + (pttruetab - pttab_Child) * ds_Child
-C
-C
-      Return
-C
-C
-      End Subroutine Agrif_Parentbounds
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_1D_Recursive 
-C     **************************************************************************
-C
-      Subroutine Agrif_Interp_1D_recursive(TypeInterp,tabin,tabout,
-     &           indmin,indmax, 
-     &           pttab_child,petab_child,
-     &           s_child,s_parent,ds_child,ds_parent,nbdim)     
-C
-CCC   Description:
-CCC   Subroutine for the interpolation of a 1D grid variable. 
-CCC   It calls Agrif_InterpBase. 
-C
-C     Declarations:
-C
-      
-C
-C     Arguments
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(1) :: TypeInterp
-      INTEGER, DIMENSION(nbdim) :: indmin,indmax
-      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
-      REAL, DIMENSION(nbdim) :: s_child,s_parent
-      REAL, DIMENSION(nbdim) :: ds_child,ds_parent
-      REAL, INTENT(IN),DIMENSION(indmin(nbdim):indmax(nbdim)) :: tabin        
-      REAL, INTENT(OUT),
-     &      DIMENSION(pttab_child(nbdim):petab_child(nbdim)) :: tabout
-      INTEGER :: coeffraf
-C
-C
-C     Commentaire perso : nbdim vaut toujours 1 ici. 
-C
-      coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
-      
-      Call Agrif_InterpBase(TypeInterp(1),
-     &                  tabin(indmin(nbdim):indmax(nbdim)),
-     &                  tabout(pttab_child(nbdim):petab_child(nbdim)),
-     &                  indmin(nbdim),indmax(nbdim),            
-     &                  pttab_child(nbdim),petab_child(nbdim),
-     &                  s_parent(nbdim),s_child(nbdim),
-     &                  ds_parent(nbdim),ds_child(nbdim),coeffraf)
-                
-C                
-      Return
-C
-C
-      End Subroutine Agrif_Interp_1D_recursive
-C
-C
-C      
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_2D_Recursive 
-C     **************************************************************************
-C
-      Subroutine Agrif_Interp_2D_recursive(TypeInterp,
-     &           tabin,tabout,
-     &           indmin,indmax,   
-     &           pttab_child,petab_child,
-     &            s_child, s_parent,
-     &           ds_child,ds_parent,
-     &           nbdim)
-C
-CCC   Description:
-CCC   Subroutine for the interpolation of a 2D grid variable. 
-CCC   It calls Agrif_Interp_1D_recursive and Agrif_InterpBase.    
-C
-C     Declarations:
-C
-      
-C     
-      INTEGER                   :: nbdim
-      INTEGER,DIMENSION(2)      :: TypeInterp
-      INTEGER, DIMENSION(nbdim) :: indmin,indmax
-      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
-      REAL   , DIMENSION(nbdim) ::  s_child, s_parent
-      REAL   , DIMENSION(nbdim) :: ds_child,ds_parent
-      REAL   ,INTENT(IN), DIMENSION(
-     &                indmin(nbdim-1):indmax(nbdim-1),
-     &                indmin(nbdim):indmax(nbdim)
-     &                ) :: tabin        
-      REAL   ,INTENT(OUT), DIMENSION(
-     &                pttab_child(nbdim-1):petab_child(nbdim-1),
-     &                pttab_child(nbdim):petab_child(nbdim)
-     &                ) :: tabout
-C
-C     Local variables      
-      REAL, DIMENSION(pttab_child(nbdim-1):petab_child(nbdim-1),
-     &                 indmin(nbdim):indmax(nbdim)) :: tabtemp
-      INTEGER i,j
-      INTEGER :: coeffraf
-      REAL   , DIMENSION(
-     &                pttab_child(nbdim):petab_child(nbdim),
-     &                pttab_child(nbdim-1):petab_child(nbdim-1)
-     &                ) :: tabout_trsp
-      REAL, DIMENSION(indmin(nbdim):indmax(nbdim),
-     &        pttab_child(nbdim-1):petab_child(nbdim-1)) :: tabtemp_trsp
-
-C
-C
-C
-C
-C     Commentaire perso : nbdim vaut toujours 2 ici.
-C
-      coeffraf = nint ( ds_parent(1) / ds_child(1) )
-      IF((TypeInterp(1) == Agrif_Linear) .AND. (coeffraf /= 1 ) )THEN
-
-!---CDIR NEXPAND
-          IF(.NOT. precomputedone(1) ) call linear1Dprecompute2D(
-     &          indmax(2)-indmin(2)+1,   
-     &          indmax(1)-indmin(1)+1,   
-     &          petab_child(1)-pttab_child(1)+1,
-     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
-!---CDIR NEXPAND
-           call linear1daftercompute(tabin,tabtemp,
-     &          size(tabin), size(tabtemp),  
-     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
- 
-      ELSEIF((TypeInterp(1) == Agrif_PPM) .AND. (coeffraf /= 1 ) )THEN
-!---CDIR NEXPAND
-          IF(.NOT. precomputedone(1) ) call ppm1Dprecompute2D(
-     &          indmax(2)-indmin(2)+1,   
-     &          indmax(1)-indmin(1)+1,   
-     &          petab_child(1)-pttab_child(1)+1,
-     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
-!---CDIR NEXPAND
-           call ppm1daftercompute(tabin,tabtemp,
-     &          size(tabin), size(tabtemp),  
-     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
-
-      ELSE
-
-      do j = indmin(nbdim),indmax(nbdim)
-C        
-!---CDIR NEXPAND
-        Call Agrif_Interp_1D_recursive(TypeInterp(1),
-     &         tabin(indmin(nbdim-1):indmax(nbdim-1),j),
-     &         tabtemp(pttab_child(nbdim-1):petab_child(nbdim-1),j),
-     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
-     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
-     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
-     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
-C        
-      enddo
-      ENDIF   
-
-      coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
-      
-      tabtemp_trsp = TRANSPOSE(tabtemp)
-
-      IF((TypeInterp(2) == Agrif_Linear) .AND. (coeffraf /= 1 ) )THEN
-
-!---CDIR NEXPAND
-          IF(.NOT. precomputedone(2) ) call linear1Dprecompute2D(
-     &          petab_child(1)-pttab_child(1)+1,
-     &          indmax(2)-indmin(2)+1,
-     &          petab_child(2)-pttab_child(2)+1,
-     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
-!---CDIR NEXPAND
-           call linear1daftercompute(tabtemp_trsp,tabout_trsp,
-     &          size(tabtemp_trsp), size(tabout_trsp),
-     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
-
-      ELSEIF((TypeInterp(2) == Agrif_PPM) .AND. (coeffraf /= 1 ) )THEN
-
-!---CDIR NEXPAND
-           IF(.NOT. precomputedone(1) )call ppm1Dprecompute2D(
-     &          petab_child(1)-pttab_child(1)+1,
-     &          indmax(2)-indmin(2)+1,
-     &          petab_child(2)-pttab_child(2)+1,
-     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
-!---CDIR NEXPAND
-           call ppm1daftercompute(tabtemp_trsp,tabout_trsp,
-     &          size(tabtemp_trsp), size(tabout_trsp),
-     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
-
-      ELSE
-      do i=pttab_child(nbdim-1),petab_child(nbdim-1)
-C
-!---CDIR NEXPAND
-        Call Agrif_InterpBase(TypeInterp(2),
-     &           tabtemp_trsp(indmin(nbdim):indmax(nbdim),i),
-     &           tabout_trsp(pttab_child(nbdim):petab_child(nbdim),i),
-     &           indmin(nbdim),indmax(nbdim),
-     &           pttab_child(nbdim),petab_child(nbdim),
-     &           s_parent(nbdim),s_child(nbdim),
-     &           ds_parent(nbdim),ds_child(nbdim),coeffraf)
-
-C        
-      enddo
-      ENDIF
-      
-      tabout = TRANSPOSE(tabout_trsp)
-C
-      Return
-C
-C
-      End Subroutine Agrif_Interp_2D_recursive
-C
-C
-C      
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_3D_Recursive 
-C     **************************************************************************
-C
-      Subroutine Agrif_Interp_3D_recursive(TypeInterp,tabin,tabout,
-     &           indmin,indmax,   
-     &           pttab_child,petab_child,
-     &           s_child,s_parent,ds_child,ds_parent,nbdim)
-C
-CCC   Description:
-CCC   Subroutine for the interpolation of a 3D grid variable. 
-CCC   It calls Agrif_Interp_2D_recursive and Agrif_InterpBase.    
-C
-C     Declarations:
-C
-      
-C     
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(3) :: TypeInterp
-      INTEGER, DIMENSION(nbdim) :: indmin,indmax
-      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
-      REAL, DIMENSION(nbdim) :: s_child,s_parent,ds_child,ds_parent
-      REAL,INTENT(IN), DIMENSION(indmin(nbdim-2):indmax(nbdim-2),
-     &                indmin(nbdim-1):indmax(nbdim-1),
-     &                indmin(nbdim)  :indmax(nbdim)) :: tabin        
-      REAL,INTENT(OUT),
-     &        DIMENSION(pttab_child(nbdim-2):petab_child(nbdim-2),
-     &                pttab_child(nbdim-1):petab_child(nbdim-1),
-     &                pttab_child(nbdim):petab_child(nbdim)) :: tabout
-C
-C     Local variables      
-      REAL, DIMENSION(pttab_child(nbdim-2):petab_child(nbdim-2),
-     &                 pttab_child(nbdim-1):petab_child(nbdim-1),
-     &                 indmin(nbdim):indmax(nbdim)) :: tabtemp
-      INTEGER i,j,k
-      INTEGER :: coeffraf, locind_child_left, kdeb
-C
-C
-      coeffraf = nint ( ds_parent(1) / ds_child(1) )
-      IF((TypeInterp(1) == Agrif_Linear) .AND. (coeffraf/=1))THEN 
-        Call linear1Dprecompute2D(
-     &          indmax(2)-indmin(2)+1,
-     &          indmax(1)-indmin(1)+1,
-     &          petab_child(1)-pttab_child(1)+1,
-     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
-      precomputedone(1) = .TRUE. 
-      ELSEIF((TypeInterp(1) == Agrif_PPM) .AND. (coeffraf/=1))THEN
-        Call ppm1Dprecompute2D(
-     &          indmax(2)-indmin(2)+1,
-     &          indmax(1)-indmin(1)+1,
-     &          petab_child(1)-pttab_child(1)+1,
-     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
-      precomputedone(1) = .TRUE.
-      ENDIF
-
-      coeffraf = nint ( ds_parent(2) / ds_child(2) )
-      IF((TypeInterp(2) == Agrif_Linear) .AND. (coeffraf/=1)) THEN
-         Call linear1Dprecompute2D(
-     &          petab_child(1)-pttab_child(1)+1,
-     &          indmax(2)-indmin(2)+1,
-     &          petab_child(2)-pttab_child(2)+1,
-     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
-      precomputedone(2) = .TRUE. 
-      ELSEIF((TypeInterp(2) == Agrif_PPM) .AND. (coeffraf/=1)) THEN
-         Call ppm1Dprecompute2D(
-     &          petab_child(1)-pttab_child(1)+1,
-     &          indmax(2)-indmin(2)+1,
-     &          petab_child(2)-pttab_child(2)+1,
-     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
-      precomputedone(2) = .TRUE.
-      ENDIF
-
-      do k = indmin(nbdim),indmax(nbdim)
-C        
-        Call Agrif_Interp_2D_recursive(TypeInterp(1:2),
-     &         tabin(indmin(nbdim-2):indmax(nbdim-2),
-     &         indmin(nbdim-1):indmax(nbdim-1),k),
-     &         tabtemp(pttab_child(nbdim-2):petab_child(nbdim-2),
-     &         pttab_child(nbdim-1):petab_child(nbdim-1),k),
-     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
-     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
-     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
-     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
-C        
-      enddo
-      
-      precomputedone(1) = .FALSE.
-      precomputedone(2) = .FALSE.
-      coeffraf = nint ( ds_parent(3) / ds_child(3) )
-
-      Call Agrif_Compute_nbdim_interp(s_parent(nbdim),s_child(nbdim),
-     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
-           
-      IF (coeffraf == 1) THEN
-      
-      kdeb = indmin(3)+locind_child_left-2
-      do k=pttab_child(3),petab_child(3)
-      kdeb = kdeb + 1
-      do j = pttab_child(2),petab_child(2)
-        do i = pttab_child(1),petab_child(1)
-        tabout(i,j,k) = tabtemp(i,j,kdeb)
-      enddo
-      enddo
-      enddo
-              
-      ELSE      
-C
-      do j=pttab_child(nbdim-1),petab_child(nbdim-1) 
-C        
-        do i=pttab_child(nbdim-2),petab_child(nbdim-2)
-C
-          Call Agrif_InterpBase(TypeInterp(3),
-     &           tabtemp(i,j,indmin(nbdim):indmax(nbdim)),
-     &           tabout(i,j,pttab_child(nbdim):petab_child(nbdim)),
-     &           indmin(nbdim),indmax(nbdim),
-     &           pttab_child(nbdim),petab_child(nbdim),
-     &           s_parent(nbdim),s_child(nbdim),
-     &           ds_parent(nbdim),ds_child(nbdim),coeffraf)
-C
-        enddo 
-C       
-      enddo
-      ENDIF
-C
-      Return
-C        
-C
-      End Subroutine Agrif_Interp_3D_recursive
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_4D_Recursive 
-C     **************************************************************************
-C
-      Subroutine Agrif_Interp_4D_recursive(TypeInterp,tabin,tabout,
-     &           indmin,indmax,   
-     &           pttab_child,petab_child,
-     &           s_child,s_parent,ds_child,ds_parent,nbdim)
-C
-CCC   Description:
-CCC   Subroutine for the interpolation of a 4D grid variable. 
-CCC   It calls Agrif_Interp_3D_recursive and Agrif_InterpBase.    
-C
-C     Declarations:
-C
-      
-C     
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(4) :: TypeInterp
-      INTEGER, DIMENSION(nbdim) :: indmin,indmax
-      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
-      REAL, DIMENSION(nbdim) :: s_child,s_parent,ds_child,ds_parent
-      REAL,INTENT(IN), DIMENSION(indmin(nbdim-3):indmax(nbdim-3),
-     &                indmin(nbdim-2):indmax(nbdim-2),
-     &                indmin(nbdim-1):indmax(nbdim-1),
-     &                indmin(nbdim):indmax(nbdim)) :: tabin        
-      REAL,INTENT(OUT),
-     &       DIMENSION(pttab_child(nbdim-3):petab_child(nbdim-3),
-     &                pttab_child(nbdim-2):petab_child(nbdim-2),
-     &                pttab_child(nbdim-1):petab_child(nbdim-1),
-     &                pttab_child(nbdim):petab_child(nbdim)) :: tabout
-C
-C     Local variables      
-      REAL, DIMENSION(pttab_child(nbdim-3):petab_child(nbdim-3),
-     &                 pttab_child(nbdim-2):petab_child(nbdim-2),
-     &                 pttab_child(nbdim-1):petab_child(nbdim-1),  
-     &                 indmin(nbdim):indmax(nbdim)) :: tabtemp
-      INTEGER i,j,k,l
-      INTEGER :: coeffraf
-C
-C
-      do l = indmin(nbdim),indmax(nbdim)
-C        
-        Call Agrif_Interp_3D_recursive(TypeInterp(1:3),
-     &         tabin(indmin(nbdim-3):indmax(nbdim-3),
-     &               indmin(nbdim-2):indmax(nbdim-2),
-     &               indmin(nbdim-1):indmax(nbdim-1),l),
-     &         tabtemp(pttab_child(nbdim-3):petab_child(nbdim-3),
-     &         pttab_child(nbdim-2):petab_child(nbdim-2),
-     &         pttab_child(nbdim-1):petab_child(nbdim-1),l),
-     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
-     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
-     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
-     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
-C        
-      enddo
-C
-      coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
-      
-      do k = pttab_child(nbdim-1),petab_child(nbdim-1)
-C
-        do j = pttab_child(nbdim-2),petab_child(nbdim-2) 
-C        
-          do i = pttab_child(nbdim-3),petab_child(nbdim-3)
-C
-            Call Agrif_InterpBase(TypeInterp(4),
-     &           tabtemp(i,j,k,indmin(nbdim):indmax(nbdim)),
-     &           tabout(i,j,k,pttab_child(nbdim):petab_child(nbdim)),
-     &           indmin(nbdim),indmax(nbdim),
-     &           pttab_child(nbdim),petab_child(nbdim),
-     &           s_parent(nbdim),s_child(nbdim),
-     &           ds_parent(nbdim),ds_child(nbdim),coeffraf)
-C
-          enddo
-C
-        enddo 
-C       
-      enddo
-C
-      Return
-C
-C        
-      End Subroutine Agrif_Interp_4D_recursive
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_5D_Recursive 
-C     **************************************************************************
-C
-      Subroutine Agrif_Interp_5D_recursive(TypeInterp,tabin,tabout,
-     &           indmin,indmax,   
-     &           pttab_child,petab_child,
-     &           s_child,s_parent,ds_child,ds_parent,nbdim)
-C
-CCC   Description:
-CCC   Subroutine for the interpolation of a 5D grid variable. 
-CCC   It calls Agrif_Interp_4D_recursive and Agrif_InterpBase.    
-C
-C     Declarations:
-C
-      
-C     
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(5) :: TypeInterp
-      INTEGER, DIMENSION(nbdim) :: indmin,indmax
-      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
-      REAL, DIMENSION(nbdim) :: s_child,s_parent,ds_child,ds_parent
-      REAL,INTENT(IN), DIMENSION(indmin(nbdim-4):indmax(nbdim-4),
-     &                indmin(nbdim-3):indmax(nbdim-3),
-     &                indmin(nbdim-2):indmax(nbdim-2),
-     &                indmin(nbdim-1):indmax(nbdim-1),
-     &                indmin(nbdim):indmax(nbdim)) :: tabin  
-      REAL,INTENT(OUT),
-     &    DIMENSION(pttab_child(nbdim-4):petab_child(nbdim-4),
-     &                pttab_child(nbdim-3):petab_child(nbdim-3),
-     &                pttab_child(nbdim-2):petab_child(nbdim-2),
-     &                pttab_child(nbdim-1):petab_child(nbdim-1),
-     &                pttab_child(nbdim):petab_child(nbdim)) :: tabout
-C
-C     Local variables      
-      REAL, DIMENSION(pttab_child(nbdim-4):petab_child(nbdim-4),
-     &                 pttab_child(nbdim-3):petab_child(nbdim-3),
-     &                 pttab_child(nbdim-2):petab_child(nbdim-2),
-     &                 pttab_child(nbdim-1):petab_child(nbdim-1),    
-     &                 indmin(nbdim):indmax(nbdim)) :: tabtemp
-      INTEGER i,j,k,l,m
-      INTEGER :: coeffraf
-C
-C
-      do m = indmin(nbdim),indmax(nbdim)
-C        
-        Call Agrif_Interp_4D_recursive(TypeInterp(1:4),
-     &         tabin(indmin(nbdim-4):indmax(nbdim-4),
-     &               indmin(nbdim-3):indmax(nbdim-3),
-     &               indmin(nbdim-2):indmax(nbdim-2),
-     &               indmin(nbdim-1):indmax(nbdim-1),m),
-     &         tabtemp(pttab_child(nbdim-4):petab_child(nbdim-4),
-     &                 pttab_child(nbdim-3):petab_child(nbdim-3),
-     &                 pttab_child(nbdim-2):petab_child(nbdim-2),
-     &                 pttab_child(nbdim-1):petab_child(nbdim-1),m),
-     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
-     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
-     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
-     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
-C        
-      enddo
-      
-      coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
-C
-      do l = pttab_child(nbdim-1),petab_child(nbdim-1) 
-C
-        do k = pttab_child(nbdim-2),petab_child(nbdim-2)
-C
-          do j = pttab_child(nbdim-3),petab_child(nbdim-3) 
-C        
-            do i = pttab_child(nbdim-4),petab_child(nbdim-4)
-C
-              Call Agrif_InterpBase(TypeInterp(5),
-     &             tabtemp(i,j,k,l,indmin(nbdim):indmax(nbdim)),
-     &                    tabout(i,j,k,l,
-     &             pttab_child(nbdim):petab_child(nbdim)),
-     &             indmin(nbdim),indmax(nbdim),
-     &             pttab_child(nbdim),petab_child(nbdim),
-     &             s_parent(nbdim),s_child(nbdim),
-     &             ds_parent(nbdim),ds_child(nbdim),coeffraf)
-C
-            enddo
-C
-          enddo
-C
-        enddo 
-C       
-      enddo
-C
-C
-      Return
-C
-C        
-      End Subroutine Agrif_Interp_5D_recursive
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_6D_Recursive 
-C     **************************************************************************
-C
-      Subroutine Agrif_Interp_6D_recursive(TypeInterp,tabin,tabout,
-     &           indmin,indmax,   
-     &           pttab_child,petab_child,
-     &           s_child,s_parent,ds_child,ds_parent,nbdim)
-C
-CCC   Description:
-CCC   Subroutine for the interpolation of a 6D grid variable. 
-CCC   It calls Agrif_Interp_4D_recursive and Agrif_InterpBase.    
-C
-C     Declarations:
-C
-      
-C     
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(6) :: TypeInterp
-      INTEGER, DIMENSION(nbdim) :: indmin,indmax
-      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
-      REAL, DIMENSION(nbdim) :: s_child,s_parent,ds_child,ds_parent
-      REAL,INTENT(IN), DIMENSION(indmin(nbdim-5):indmax(nbdim-5),
-     &                indmin(nbdim-4):indmax(nbdim-4),
-     &                indmin(nbdim-3):indmax(nbdim-3), 
-     &                indmin(nbdim-2):indmax(nbdim-2),
-     &                indmin(nbdim-1):indmax(nbdim-1),
-     &                indmin(nbdim):indmax(nbdim)) :: tabin        
-      REAL,INTENT(OUT),
-     &    DIMENSION(pttab_child(nbdim-5):petab_child(nbdim-5),
-     &                pttab_child(nbdim-4):petab_child(nbdim-4),
-     &                pttab_child(nbdim-3):petab_child(nbdim-3),
-     &                pttab_child(nbdim-2):petab_child(nbdim-2),
-     &                pttab_child(nbdim-1):petab_child(nbdim-1),
-     &                pttab_child(nbdim):petab_child(nbdim)) :: tabout
-C
-C     Local variables      
-      REAL, DIMENSION(pttab_child(nbdim-5):petab_child(nbdim-5),
-     &                 pttab_child(nbdim-4):petab_child(nbdim-4),
-     &                 pttab_child(nbdim-3):petab_child(nbdim-3),
-     &                 pttab_child(nbdim-2):petab_child(nbdim-2),    
-     &                 pttab_child(nbdim-1):petab_child(nbdim-1),    
-     &                 indmin(nbdim):indmax(nbdim)) :: tabtemp
-      INTEGER i,j,k,l,m,n
-      INTEGER :: coeffraf
-C
-C        
-C
-      do n = indmin(nbdim),indmax(nbdim)
-C        
-        Call Agrif_Interp_5D_recursive(TypeInterp(1:5),
-     &         tabin(indmin(nbdim-5):indmax(nbdim-5),
-     &               indmin(nbdim-4):indmax(nbdim-4),
-     &               indmin(nbdim-3):indmax(nbdim-3),
-     &               indmin(nbdim-2):indmax(nbdim-2),
-     &               indmin(nbdim-1):indmax(nbdim-1),n),
-     &         tabtemp(pttab_child(nbdim-5):petab_child(nbdim-5),
-     &                 pttab_child(nbdim-4):petab_child(nbdim-4),
-     &                 pttab_child(nbdim-3):petab_child(nbdim-3),
-     &                 pttab_child(nbdim-2):petab_child(nbdim-2),
-     &                 pttab_child(nbdim-1):petab_child(nbdim-1),n),
-     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
-     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
-     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
-     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
-C        
-      enddo
-      
-      coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
-C
-      do m = pttab_child(nbdim-1),petab_child(nbdim-1) 
-      do l = pttab_child(nbdim-2),petab_child(nbdim-2) 
-C
-        do k = pttab_child(nbdim-3),petab_child(nbdim-3)
-C
-          do j = pttab_child(nbdim-4),petab_child(nbdim-4) 
-C        
-            do i = pttab_child(nbdim-5),petab_child(nbdim-5)
-C
-              Call Agrif_InterpBase(TypeInterp(6),
-     &             tabtemp(i,j,k,l,m,indmin(nbdim):indmax(nbdim)),
-     &                    tabout(i,j,k,l,m,
-     &                    pttab_child(nbdim):petab_child(nbdim)),
-     &             indmin(nbdim),indmax(nbdim),
-     &             pttab_child(nbdim),petab_child(nbdim),
-     &             s_parent(nbdim),s_child(nbdim),
-     &             ds_parent(nbdim),ds_child(nbdim),coeffraf)
-C
-            enddo
-C
-          enddo
-C
-        enddo 
-C       
-      enddo
-      enddo
-C                
-C
-      Return
-C
-C        
-      End Subroutine Agrif_Interp_6D_recursive
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_InterpBase  
-C     **************************************************************************
-C  
-      Subroutine Agrif_InterpBase(TypeInterp,
-     &                           parenttab,childtab,
-     &                           indmin,indmax,pttab_child,petab_child,
-     &                           s_parent,s_child,ds_parent,ds_child,
-     &                           coeffraf)   
-C
-CCC   Description:
-CCC   Subroutine calling the interpolation method chosen by the user (linear, 
-CCC   lagrange or spline). 
-C
-C     Declarations:
-C
-      
-C
-      INTEGER                :: TypeInterp
-      INTEGER :: indmin,indmax
-      INTEGER :: pttab_child,petab_child
-      REAL,INTENT(IN),DIMENSION(indmin:indmax)           :: parenttab       
-      REAL,INTENT(OUT),DIMENSION(pttab_child:petab_child) :: childtab        
-      REAL    :: s_parent,s_child,ds_parent,ds_child 
-      INTEGER :: coeffraf
-C 
-C
-       IF ((indmin == indmax).AND.(pttab_child == petab_child)) THEN
-         childtab(pttab_child) = parenttab(indmin)
-       ELSEIF (TYPEinterp .EQ. AGRIF_LINEAR) then    
-C
-C         Linear interpolation 
-  
-          Call linear1D
-     &         (parenttab,childtab,
-     &          indmax-indmin+1,petab_child-pttab_child+1,
-     &          s_parent,s_child,ds_parent,ds_child)
-C          
-      elseif ( TYPEinterp .EQ. AGRIF_PPM ) then
-
-          Call ppm1D
-     &         (parenttab,childtab,
-     &         indmax-indmin+1,petab_child-pttab_child+1,
-     &         s_parent,s_child,ds_parent,ds_child)
-C
-
-        elseif (TYPEinterp .EQ. AGRIF_LAGRANGE) then
-C          
-C         Lagrange interpolation    
-          Call lagrange1D
-     &        (parenttab,childtab,
-     &         indmax-indmin+1,petab_child-pttab_child+1,
-     &         s_parent,s_child,ds_parent,ds_child)
-C            
-        elseif (TYPEinterp .EQ. AGRIF_ENO) then
-C          
-C         Eno interpolation
-          Call eno1D
-     &         (parenttab,childtab,
-     &         indmax-indmin+1,petab_child-pttab_child+1,
-     &         s_parent,s_child,ds_parent,ds_child)
-C        
-        elseif (TYPEinterp .EQ. AGRIF_WENO) then
-C          
-C         Eno interpolation
-          Call weno1D
-     &         (parenttab,childtab,
-     &         indmax-indmin+1,petab_child-pttab_child+1,
-     &         s_parent,s_child,ds_parent,ds_child)
-C            
-        Else if (TYPEinterp .EQ. AGRIF_LINEARCONSERV) then
-C          
-C         Linear conservative interpolation
-          
-          Call linear1Dconserv
-     &         (parenttab,childtab,
-     &         indmax-indmin+1,petab_child-pttab_child+1,
-     &         s_parent,s_child,ds_parent,ds_child)   
-C              
-        Else if (TYPEinterp .EQ. AGRIF_LINEARCONSERVLIM) then
-C          
-C         Linear conservative interpolation
-          
-          Call linear1Dconservlim
-     &         (parenttab,childtab,
-     &         indmax-indmin+1,petab_child-pttab_child+1,
-     &         s_parent,s_child,ds_parent,ds_child)         
-C              
-        elseif (TYPEinterp .EQ. AGRIF_CONSTANT) then
-C          
-          Call constant1D
-     &         (parenttab,childtab,
-     &         indmax-indmin+1,petab_child-pttab_child+1,
-     &         s_parent,s_child,ds_parent,ds_child)
-C              
-      endif 
-C
-C      
-      End Subroutine Agrif_InterpBase 
-C
-
-      Subroutine Agrif_Compute_nbdim_interp(s_parent,s_child,
-     &  ds_parent,ds_child,coeffraf,locind_child_left)
-      real :: s_parent,s_child,ds_parent,ds_child
-      integer :: coeffraf,locind_child_left
-     
-      coeffraf = nint(ds_parent/ds_child)
-      locind_child_left = 1 + agrif_int((s_child-s_parent)/ds_parent)
-      End Subroutine Agrif_Compute_nbdim_interp
-C          
-
-      Subroutine Agrif_Find_list_interp(list_interp,pttab,petab,
-     &                          pttab_Child,pttab_Parent,nbdim,
-     &                          indmin,indmax,indminglob,
-     &      indmaxglob,indminglob2,indmaxglob2,parentarray,
-     &       pttruetab,cetruetab,member,memberin,
-     &      find_list_interp
-#if defined key_mpp_mpi
-     &     ,tab4t,memberinall,sendtoproc1,recvfromproc1
-#endif
-     &    )     
-      TYPE(Agrif_List_Interp_Loc), Pointer :: list_interp
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(nbdim)   :: pttab,petab,pttab_Child,pttab_Parent
-      LOGICAL :: find_list_interp
-      Type(Agrif_List_Interp_loc), Pointer :: parcours
-      INTEGER,DIMENSION(nbdim)   :: indmin,indmax  
-      INTEGER,DIMENSION(nbdim)   :: indminglob,indmaxglob
-      INTEGER,DIMENSION(nbdim)   :: pttruetab,cetruetab      
-      INTEGER,DIMENSION(nbdim)   :: indminglob2,indmaxglob2  
-      INTEGER,DIMENSION(nbdim,2,2) :: parentarray
-      LOGICAL :: member, memberin
-      INTEGER :: i
-#ifdef key_mpp_mpi
-C
-      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
-      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall
-      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1
-#endif 
-                    
-      find_list_interp = .FALSE.
-      
-      parcours => list_interp
-      Find_loop :   Do While (associated(parcours))
-        Do i=1,nbdim
-          IF ((pttab(i) /= parcours%interp_loc%pttab(i)).OR.
-     &        (petab(i) /= parcours%interp_loc%petab(i)).OR.
-     &        (pttab_child(i) /= parcours%interp_loc%pttab_child(i)).OR.
-     &        (pttab_parent(i) /= parcours%interp_loc%pttab_parent(i)))
-     &               THEN
-            parcours=>parcours%suiv
-            Cycle Find_loop
-          ENDIF
-        EndDo
-
-        indmin = parcours%interp_loc%indmin(1:nbdim)
-        indmax = parcours%interp_loc%indmax(1:nbdim)
-        
-        pttruetab = parcours%interp_loc%pttruetab(1:nbdim)
-        cetruetab = parcours%interp_loc%cetruetab(1:nbdim)
-                
-#if !defined key_mpp_mpi
-        indminglob = parcours%interp_loc%indminglob(1:nbdim)
-        indmaxglob = parcours%interp_loc%indmaxglob(1:nbdim)
-#else
-        indminglob2 = parcours%interp_loc%indminglob2(1:nbdim)
-        indmaxglob2 = parcours%interp_loc%indmaxglob2(1:nbdim)
-        parentarray = parcours%interp_loc%parentarray(1:nbdim,:,:)
-        member = parcours%interp_loc%member
-        tab4t = parcours%interp_loc%tab4t(1:nbdim,0:Agrif_Nbprocs-1,1:8)
-        memberinall = parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1)
-        sendtoproc1 = parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1)
-        recvfromproc1 = 
-     &    parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1)
-#endif        
-        memberin = parcours%interp_loc%memberin
-        find_list_interp = .TRUE.   
-        Exit Find_loop
-      End Do Find_loop  
-                              
-      End Subroutine Agrif_Find_list_interp   
-      
-      Subroutine Agrif_AddTo_list_interp(list_interp,pttab,petab,
-     &                          pttab_Child,pttab_Parent,indmin,indmax,
-     &                          indminglob,indmaxglob,
-     &                          indminglob2,indmaxglob2,
-     &                          parentarray,pttruetab,cetruetab,
-     &                          member,memberin,nbdim
-#if defined key_mpp_mpi
-     &      ,tab4t,memberinall,sendtoproc1,recvfromproc1
-#endif
-     &    )
-          
-      TYPE(Agrif_List_Interp_Loc), Pointer :: list_interp
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(nbdim)   :: pttab,petab,pttab_Child,pttab_Parent
-      INTEGER,DIMENSION(nbdim)   :: indmin,indmax
-      INTEGER,DIMENSION(nbdim)   :: indminglob,indmaxglob
-      INTEGER,DIMENSION(nbdim)   :: indminglob2,indmaxglob2
-      INTEGER,DIMENSION(nbdim)   :: pttruetab,cetruetab
-      INTEGER,DIMENSION(nbdim,2,2) :: parentarray
-      LOGICAL :: member, memberin
-#ifdef key_mpp_mpi
-C
-      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
-      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: memberinall
-      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1
-      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: recvfromproc1
-#endif                   
-      Type(Agrif_List_Interp_loc), Pointer :: parcours
-            
-       Allocate(parcours)
-      Allocate(parcours%interp_loc)
-      
-      parcours%interp_loc%pttab(1:nbdim) = pttab(1:nbdim)
-      parcours%interp_loc%petab(1:nbdim) = petab(1:nbdim)
-      parcours%interp_loc%pttab_child(1:nbdim) = pttab_child(1:nbdim)
-      parcours%interp_loc%pttab_parent(1:nbdim) = pttab_parent(1:nbdim)
-  
-  
-      parcours%interp_loc%indmin(1:nbdim) = indmin(1:nbdim)
-      parcours%interp_loc%indmax(1:nbdim) = indmax(1:nbdim)
-
-      parcours%interp_loc%memberin = memberin
-#if !defined key_mpp_mpi
-      parcours%interp_loc%indminglob(1:nbdim) = indminglob(1:nbdim)
-      parcours%interp_loc%indmaxglob(1:nbdim) = indmaxglob(1:nbdim)
-#else
-      parcours%interp_loc%indminglob2(1:nbdim) = indminglob2(1:nbdim)
-      parcours%interp_loc%indmaxglob2(1:nbdim) = indmaxglob2(1:nbdim)
-      parcours%interp_loc%parentarray(1:nbdim,:,:) 
-     &       = parentarray(1:nbdim,:,:)
-      parcours%interp_loc%member = member
-      Allocate(parcours%interp_loc%tab4t(nbdim,0:Agrif_Nbprocs-1,8))
-      Allocate(parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1))
-      Allocate(parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1))
-      Allocate(parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1))                  
-      parcours%interp_loc%tab4t=tab4t   
-      parcours%interp_loc%memberinall=memberinall   
-      parcours%interp_loc%sendtoproc1=sendtoproc1
-      parcours%interp_loc%recvfromproc1=recvfromproc1            
-#endif      
-
-      parcours%interp_loc%pttruetab(1:nbdim) = pttruetab(1:nbdim)
-      parcours%interp_loc%cetruetab(1:nbdim) = cetruetab(1:nbdim)
-      
-      parcours%suiv => list_interp
-      
-      list_interp => parcours
-      End Subroutine Agrif_Addto_list_interp 
-                
-      End Module Agrif_Interpolation
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F90	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F90	(revision 6440)
@@ -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: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterpbasic.F
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterpbasic.F	(revision 6439)
+++ 	(revision )
@@ -1,1706 +1,0 @@
-!
-! $Id: modinterpbasic.F 2715 2011-03-30 15:58:35Z rblod $
-!
-C     AGRIF (Adaptive Grid Refinement In Fortran)
-C
-C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
-C
-C     This program is free software; you can redistribute it and/or modify
-C     it under the terms of the GNU General Public License as published by
-C     the Free Software Foundation; either version 2 of the License, or
-C     (at your option) any later version.
-C
-C     This program is distributed in the hope that it will be useful,
-C     but WITHOUT ANY WARRANTY; without even the implied warranty of
-C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-C     GNU General Public License for more details.
-C
-C     You should have received a copy of the GNU General Public License
-C     along with this program; if not, write to the Free Software
-C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
-C
-C
-C
-CCC   Module Agrif_Interpbasic
-C
-      Module Agrif_Interpbasic
-C
-CCC   Description:
-CCC   Module containing different procedures of interpolation (linear,lagrange,
-CCC   spline,...) used in the Agrif_Interpolation module.
-C
-C     Modules used:
-      USE Agrif_types
-C
-      IMPLICIT NONE
-C             
-      Real,Dimension(Agrif_MaxRaff) :: tabdiff2, tabdiff3
-      Real,Dimension(5,Agrif_MaxRaff,3) :: tabppm
-      Real,Dimension(:),Allocatable::tabtest4   
-      Integer, Dimension(:,:), Allocatable :: indparent
-      Integer, Dimension(:,:), Allocatable :: 
-     &           indparentppm,indchildppm
-      Integer, Dimension(:), Allocatable :: 
-     &           indparentppm_1d,indchildppm_1d
-      Real, Dimension(:,:),Allocatable :: coeffparent   
-       
-      CONTAINS
-C     Define procedures contained in this module
-C  
-C     **************************************************************************  
-CCC   Subroutine Linear1d  
-C     ************************************************************************** 
-C 
-      Subroutine Linear1d(x,y,np,nc,
-     &                    s_parent,s_child,ds_parent,ds_child) 
-C
-CCC   Description:
-CCC   Subroutine to do a linear 1D interpolation on a child grid (vector y) from
-CCC   its parent grid (vector x).  
-C
-CC    Method:
-C
-C     Declarations:
-C
-      
-C        
-C     Arguments
-      INTEGER             :: np,nc      
-      REAL,INTENT(IN), DIMENSION(np) :: x      
-      REAL,INTENT(OUT), DIMENSION(nc) :: y  
-      REAL                :: s_parent,s_child,ds_parent,ds_child
-C
-C     Local scalars
-      INTEGER :: i,coeffraf,locind_parent_left
-      REAL    :: ypos,globind_parent_left,globind_parent_right
-      REAL    :: invds, invds2
-      REAL :: ypos2,diff
-C
-C
-
-      coeffraf = nint(ds_parent/ds_child)
-C
-      if (coeffraf == 1) then
-C
-          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
-C        
-          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
-C
-          return
-C
-      endif                          
-C
-      ypos = s_child 
-
-      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-
-        globind_parent_left = s_parent 
-     &                        + (locind_parent_left - 1)*ds_parent
-
-        globind_parent_right = globind_parent_left + ds_parent
-
-C
-      invds = 1./ds_parent
-      invds2 = ds_child/ds_parent
-      
-      ypos2 = ypos*invds
-      globind_parent_right=globind_parent_right*invds
-      
-      do i = 1,nc-1
-C
-        if (ypos2 > globind_parent_right) then
-           locind_parent_left = locind_parent_left + 1.
-           globind_parent_right = globind_parent_right + 1.
-           ypos2 = ypos*invds+(i-1)*invds2           
-        endif
-        
-        diff=(globind_parent_right - ypos2)
-        y(i) = (diff*x(locind_parent_left)
-     &        + (1.-diff)*x(locind_parent_left+1))
-C
-        ypos2 = ypos2 + invds2
-C
-      enddo
-C
-      ypos = s_child + (nc-1)*ds_child
-      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-C
-      if (locind_parent_left == np) then
-C
-          y(nc) = x(np)
-C
-        else
-C
-          globind_parent_left = s_parent 
-     &                        + (locind_parent_left - 1)*ds_parent  
-C      
-          y(nc) = ((globind_parent_left + ds_parent - ypos)
-     &            *x(locind_parent_left)
-     &          + (ypos - globind_parent_left)
-     &            *x(locind_parent_left+1))*invds
-C
-      endif                                          
-C           
-      Return
-C
-C       
-      End Subroutine Linear1d   
-      
-      Subroutine Linear1dprecompute2d(np2, np,nc,
-     &                    s_parent,s_child,ds_parent,ds_child,dir)
-C
-CCC   Description:
-CCC   Subroutine to compute 2D coefficient and index for a linear 1D interpolation
-CCC   on a child grid (vector y) from its parent grid (vector x).
-C
-CC    Method:
-C
-C     Declarations:
-C
-
-C        
-C     Arguments
-      INTEGER             :: np,nc,np2,dir
-      REAL                :: s_parent,s_child,ds_parent,ds_child
-C
-C     Local scalars
-      INTEGER :: i,j,coeffraf,locind_parent_left,inc,inc1,inc2,toto 
-      Integer, Dimension(:,:), Allocatable :: indparent_tmp
-      Real, Dimension(:,:), Allocatable :: coeffparent_tmp
-      REAL    :: ypos,globind_parent_left,globind_parent_right
-      REAL    :: invds, invds2, invds3
-      REAL :: ypos2,diff
-C
-C
-
-      coeffraf = nint(ds_parent/ds_child)
-C
-      ypos = s_child
-
-      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-
-        globind_parent_left = s_parent
-     &                        + (locind_parent_left - 1)*ds_parent
-
-        globind_parent_right = globind_parent_left + ds_parent
-
-C
-      invds = 1./ds_parent
-      invds2 = ds_child/ds_parent
-      invds3 = 0.5/real(coeffraf)
-
-      ypos2 = ypos*invds
-      globind_parent_right=globind_parent_right*invds
-
-      if (.not.allocated(indparent)) then
-      allocate(indparent(nc*np2,3),coeffparent(nc*np2,3))
-      else
-      if (size(indparent,1)<nc*np2) then
-      allocate(coeffparent_tmp(size(indparent,1),size(indparent,2)))
-      allocate(indparent_tmp(size(indparent,1),size(indparent,2)))
-      coeffparent_tmp=coeffparent 
-      indparent_tmp=indparent 
-      deallocate(indparent,coeffparent)
-      allocate(indparent(nc*np2,3),coeffparent(nc*np2,3))
-      coeffparent(1:size(coeffparent_tmp,1),1:size(coeffparent_tmp,2))
-     &  = coeffparent_tmp 
-      indparent(1:size(indparent_tmp,1),1:size(indparent_tmp,2))
-     & = indparent_tmp
-      deallocate(indparent_tmp,coeffparent_tmp)
-      endif
-      endif
-
-      do i = 1,nc-1
-C
-        if (ypos2 > globind_parent_right) then
-           locind_parent_left = locind_parent_left + 1
-           globind_parent_right = globind_parent_right + 1.
-           ypos2 = ypos*invds+(i-1)*invds2
-        endif
-
-        diff=(globind_parent_right - ypos2)
-        diff = invds3*nint(2*coeffraf*diff)
-        indparent(i,dir) = locind_parent_left
-
-        coeffparent(i,dir) = diff
-        
-        ypos2 = ypos2 + invds2
-C
-      enddo
-C
-      ypos = s_child + (nc-1)*ds_child
-      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-
-      if (locind_parent_left == np) then
-      indparent(nc,dir) = locind_parent_left-1
-      coeffparent(nc,dir) = 0.
-        else
-C
-          globind_parent_left = s_parent
-     &                        + (locind_parent_left - 1)*ds_parent
-C      
-       indparent(nc,dir) = locind_parent_left
-       diff = (globind_parent_left + ds_parent - ypos)
-     &       * invds
-        diff = invds3*nint(2*coeffraf*diff)
-         coeffparent(nc,dir) = diff
-      endif                                           
-
-      do i=2, np2
-      inc  =  i*nc
-      inc1 = (i-1)*nc
-      inc2 = (i-2)*nc 
-!CDIR ALTCODE
-      indparent(1+inc1:inc,dir) = indparent(1+inc2:inc1,dir)+np
-!CDIR ALTCODE
-      coeffparent(1+inc1:inc,dir) =coeffparent(1:nc,dir)
-      enddo      
-
-      Return
-C
-C       
-      End Subroutine Linear1dprecompute2d
-
-
-
-      Subroutine Linear1dprecompute(np,nc,
-     &                    s_parent,s_child,ds_parent,ds_child) 
-C
-CCC   Description:
-CCC   Subroutine to compute 1D coefficient and index for a linear 1D interpolation
-CCC   on a child grid (vector y) from its parent grid (vector x).
-C
-CC    Method:
-C
-C     Declarations:
-C
-      
-C        
-C     Arguments
-      INTEGER             :: np,nc 
-      REAL                :: s_parent,s_child,ds_parent,ds_child
-C
-C     Local scalars
-      INTEGER :: i,coeffraf,locind_parent_left
-      REAL    :: ypos,globind_parent_left,globind_parent_right
-      REAL    :: invds, invds2, invds3
-      REAL :: ypos2,diff
-C
-C
-
-      coeffraf = nint(ds_parent/ds_child)
-C
-      if (coeffraf == 1) then
-C
-          return
-C
-      endif                          
-C
-      ypos = s_child 
-
-      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-
-        globind_parent_left = s_parent 
-     &                        + (locind_parent_left - 1)*ds_parent
-
-        globind_parent_right = globind_parent_left + ds_parent
-
-C
-      invds = 1./ds_parent
-      invds2 = ds_child/ds_parent
-      invds3 = 0.5/real(coeffraf)      
-      
-      ypos2 = ypos*invds
-      globind_parent_right=globind_parent_right*invds
-      
-      if (.not.allocated(indparent)) then
-      allocate(indparent(nc,1),coeffparent(nc,1))
-      else
-      if (size(indparent)<nc) then
-      deallocate(indparent,coeffparent)
-      allocate(indparent(nc,1),coeffparent(nc,1))
-      endif
-      endif
-      
-      do i = 1,nc-1
-C
-        if (ypos2 > globind_parent_right) then
-           locind_parent_left = locind_parent_left + 1
-           globind_parent_right = globind_parent_right + 1.
-           ypos2 = ypos*invds+(i-1)*invds2           
-        endif
-        
-        diff=(globind_parent_right - ypos2)
-        
-        diff = invds3*nint(2*coeffraf*diff)
-                
-        indparent(i,1) = locind_parent_left
-
-        coeffparent(i,1) = diff
-        ypos2 = ypos2 + invds2
-C
-      enddo
-C
-      ypos = s_child + (nc-1)*ds_child
-      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-      
-      if (locind_parent_left == np) then
-      indparent(nc,1) = locind_parent_left-1
-      coeffparent(nc,1) = 0.
-        else
-C
-          globind_parent_left = s_parent 
-     &                        + (locind_parent_left - 1)*ds_parent  
-C      
-       indparent(nc,1) = locind_parent_left
-       
-       diff = (globind_parent_left + ds_parent - ypos)
-     &       * invds
-        diff = invds3*nint(2*coeffraf*diff)
-         coeffparent(nc,1) = diff
-      endif                                          
-C           
-      Return
-C
-C       
-      End Subroutine Linear1dprecompute 
-      
-      Subroutine Linear1daftercompute(x,y,np,nc,
-     &                    s_parent,s_child,ds_parent,ds_child,dir) 
-C
-CCC   Description:
-CCC   Subroutine to do a linear 1D interpolation on a child grid (vector y) from
-CCC   its parent grid (vector x) using precomputed coefficient and index.  
-C
-CC    Method:
-C
-C     Declarations:
-C
-      
-C        
-C     Arguments
-      INTEGER             :: np,nc,dir      
-      REAL,INTENT(IN), DIMENSION(np) :: x      
-      REAL,INTENT(OUT), DIMENSION(nc) :: y  
-      REAL                :: s_parent,s_child,ds_parent,ds_child
-C
-C     Local scalars
-      INTEGER :: i,coeffraf,locind_parent_left
-      REAL    :: ypos,globind_parent_left,globind_parent_right
-      REAL    :: invds, invds2
-      REAL :: ypos2,diff
-C
-C
-
-!CDIR ALTCODE
-!CDIR NODEP
-      do i = 1,nc
-C
-       y(i)=coeffparent(i,dir)*x(MAX(indparent(i,dir),1))+
-     &      (1.-coeffparent(i,dir))*x(indparent(i,dir)+1)
-C
-      enddo                                     
-C           
-      Return
-C
-C       
-      End Subroutine Linear1daftercompute            
-       
-C
-C
-C
-C     **************************************************************************  
-CCC   Subroutine Lagrange1d  
-C     **************************************************************************
-C
-      Subroutine Lagrange1d(x,y,np,nc,
-     &                      s_parent,s_child,ds_parent,ds_child)
-C
-CCC   Description:
-CCC   Subroutine to do a lagrange 1D interpolation on a child grid (vector y) 
-CCC   from its parent grid (vector x).  
-C
-CC    Method:
-C
-C     Declarations:
-C
-      
-C             
-C     Arguments
-      INTEGER             :: np,nc      
-      REAL,INTENT(IN), DIMENSION(np) :: x      
-      REAL,INTENT(OUT), DIMENSION(nc) :: y  
-      REAL                :: s_parent,s_child,ds_parent,ds_child 
-C
-C     Local scalars
-      INTEGER :: i,coeffraf,locind_parent_left
-      REAL    :: ypos,globind_parent_left
-      REAL    :: X1,X2,X3 
-      real :: deltax,invdsparent
-      real t1,t2,t3,t4,t5,t6,t7,t8
-C
-C 
-      if (np <= 2) then
-C      
-          Call Linear1D(x,y,np,nc,
-     &                  s_parent,s_child,ds_parent,ds_child)
-C         
-         Return
-C 
-      endif
-C
-      coeffraf = nint(ds_parent/ds_child)
-C
-      if (coeffraf == 1) then
-C
-          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
-C        
-          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
-C
-          return
-C
-      endif
-      
-      invdsparent=1./ds_parent
-C
-      ypos = s_child      
-C
-      do i = 1,nc
-C
-        locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-C
-
-        globind_parent_left = s_parent 
-     &                        + (locind_parent_left - 1)*ds_parent 
-     
-C        deltax = invdsparent*(ypos-globind_parent_left)
-        deltax = nint(coeffraf*deltax)/real(coeffraf)
-        
-        ypos = ypos + ds_child
-         if (abs(deltax).LE.0.0001) then
-           y(i)=x(locind_parent_left)
-           
-           cycle
-         endif
-C           
-C
-        t2 = deltax - 2.
-        t3 = deltax - 1.
-        t4 = deltax + 1.
-        
-        t5 = -(1./6.)*deltax*t2*t3
-        t6 = 0.5*t2*t3*t4
-        t7 = -0.5*deltax*t2*t4
-        t8 = (1./6.)*deltax*t3*t4
-        
-        y(i)=t5*x(locind_parent_left-1)+t6*x(locind_parent_left)
-     &  +t7*x(locind_parent_left+1)+t8*x(locind_parent_left+2)
-C
-C
-      enddo
-C
-      return
-C
-C       
-      End Subroutine Lagrange1d 
-C
-C
-C     **************************************************************************  
-CCC   Subroutine Constant1d  
-C     ************************************************************************** 
-C 
-      Subroutine constant1d(x,y,np,nc,
-     &                    s_parent,s_child,ds_parent,ds_child) 
-C
-CCC   Description:
-CCC   Subroutine to do a linear 1D interpolation on a child grid (vector y) from
-CCC   its parent grid (vector x).  
-C
-CC    Method:
-C
-C     Declarations:
-C
-      
-C        
-C     Arguments
-      INTEGER             :: np,nc      
-      REAL,INTENT(IN), DIMENSION(np) :: x      
-      REAL,INTENT(OUT), DIMENSION(nc) :: y  
-      REAL                :: s_parent,s_child,ds_parent,ds_child
-C
-C     Local scalars
-      INTEGER :: i,coeffraf,locind_parent
-      REAL    :: ypos
-C
-C
-
-      coeffraf = nint(ds_parent/ds_child)
-C
-      if (coeffraf == 1) then
-C
-          locind_parent = 1 + nint((s_child - s_parent)/ds_parent)
-C        
-          y(1:nc) = x(locind_parent:locind_parent+nc-1)
-C
-          return
-C
-      endif                          
-C
-      ypos = s_child      
-C
-      do i = 1,nc
-C
-        locind_parent = 1 + nint((ypos - s_parent)/ds_parent)
-C
-        y(i) = x(locind_parent)
-C
-        ypos = ypos + ds_child
-C
-      enddo
-C           
-      Return
-C
-C       
-      End Subroutine constant1d   
-C
-C     **************************************************************************  
-CCC   Subroutine Linear1dconserv
-C     ************************************************************************** 
-C 
-      Subroutine Linear1dconserv(x,y,np,nc,
-     &                    s_parent,s_child,ds_parent,ds_child) 
-C
-CCC   Description:
-CCC   Subroutine to do a linear 1D interpolation on a child grid (vector y) from
-CCC   its parent grid (vector x).  
-C
-CC    Method:
-C
-C     Declarations:
-C
-      Implicit none
-C        
-C     Arguments
-      Integer             :: np,nc      
-      Real, Dimension(np) :: x      
-      Real, Dimension(nc) :: y
-      Real, Dimension(:),Allocatable :: ytemp
-      Real                :: s_parent,s_child,ds_parent,ds_child
-C
-C     Local scalars
-      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
-      Real    :: ypos
-      integer :: i1,i2,ii
-      real :: xpmin,xpmax,slope
-      INTEGER :: diffmod
-      REAL :: xdiffmod
-
-C
-C
-
-      coeffraf = nint(ds_parent/ds_child)
-C
-      If (coeffraf == 1) Then
-C
-          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
-C        
-          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
-C
-          return
-C
-      End If
-C              
-      diffmod = 0
-      IF (mod(coeffraf,2) == 0) diffmod = 1  
-
-      xdiffmod = real(diffmod)/2.
-                         
-      allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
-C
-      ypos = s_child  
-C      
-      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) 
-
-      locind_parent_last = 1 +
-     &  agrif_ceiling((ypos +(nc - 1) *ds_child - s_parent)/ds_parent)
-     
-      xpmin = s_parent + (locind_parent_left-1)*ds_parent 
-      xpmax = s_parent + (locind_parent_last-1)*ds_parent          
-      
-      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
-      i2 = 1+agrif_int((xpmax-s_child)/ds_child)
-
-      i = i1
-      
-      if (locind_parent_left == 1) then
-        slope=
-     &   (x(locind_parent_left+1)-x(locind_parent_left))/(coeffraf)
-      else
-         slope=
-     &   (x(locind_parent_left+1)-x(locind_parent_left-1))/(2.*coeffraf)
-      endif
-      
-        do ii=i-coeffraf/2+diffmod,i+coeffraf/2
-          ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
-        enddo 
-
-        locind_parent_left = locind_parent_left + 1
-                      
-      do i=i1 +  coeffraf, i2 - coeffraf,coeffraf
-        slope=
-     &   (x(locind_parent_left+1)-x(locind_parent_left-1))/(2.*coeffraf)
-        do ii=i-coeffraf/2+diffmod,i+coeffraf/2
-          ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
-        enddo
-        locind_parent_left = locind_parent_left + 1
-      enddo
-      
-      i = i2
-      
-      if (locind_parent_left == np) then
-        slope=
-     &   (x(locind_parent_left)-x(locind_parent_left-1))/(coeffraf)
-      else
-         slope=
-     &   (x(locind_parent_left+1)-x(locind_parent_left-1))/(2.*coeffraf)
-      endif
-      
-        do ii=i-coeffraf/2+diffmod,nc
-          ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
-        enddo      
-C
-      y(1:nc)=ytemp(1:nc)                                   
-C           
-      deallocate(ytemp)
-      Return
-C       
-      End Subroutine Linear1dconserv
-      
-C
-C     **************************************************************************  
-CCC   Subroutine Linear1dconservlim
-C     ************************************************************************** 
-C 
-      Subroutine Linear1dconservlim(x,y,np,nc,
-     &                    s_parent,s_child,ds_parent,ds_child) 
-C
-CCC   Description:
-CCC   Subroutine to do a linear 1D interpolation on a child grid (vector y) from
-CCC   its parent grid (vector x).  
-C
-CC    Method:
-C
-C     Declarations:
-C
-      Implicit none
-C        
-C     Arguments
-      Integer             :: np,nc      
-      Real, Dimension(np) :: x      
-      Real, Dimension(nc) :: y
-      Real, Dimension(:),Allocatable :: ytemp
-      Real                :: s_parent,s_child,ds_parent,ds_child
-C
-C     Local scalars
-      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
-      Real    :: ypos
-      integer :: i1,i2,ii
-      real :: xpmin,xpmax,slope
-      INTEGER :: diffmod
-      real :: xdiffmod
-C
-C
-
-      coeffraf = nint(ds_parent/ds_child)
-C
-      If (coeffraf == 1) Then
-C
-          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
-C        
-          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
-C
-          return
-C
-      End If
-C
-      IF (coeffraf .NE.3) THEN
-      print *,'LINEARCONSERVLIM not ready for refinement ratio = ',
-     &   coeffraf
-      stop
-      ENDIF   
-      
-      diffmod = 0
-      IF (mod(coeffraf,2) == 0) diffmod = 1        
-
-      xdiffmod = real(diffmod)/2.
-                         
-      allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
-C
-      ypos = s_child  
-C      
-      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) 
-
-      locind_parent_last = 1 +
-     &  agrif_ceiling((ypos +(nc - 1) *ds_child - s_parent)/ds_parent)
-     
-      xpmin = s_parent + (locind_parent_left-1)*ds_parent 
-      xpmax = s_parent + (locind_parent_last-1)*ds_parent          
-      
-      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
-      i2 = 1+agrif_int((xpmax-s_child)/ds_child)
-
-      i = i1
-      
-      if (locind_parent_left == 1) then
-        slope=0.       
-      else
-        slope = vanleer(x(locind_parent_left-1:locind_parent_left+1))
-        slope = slope / coeffraf    
-      endif
-      
-        do ii=i-coeffraf/2+diffmod,i+coeffraf/2
-          ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
-        enddo 
-
-        locind_parent_left = locind_parent_left + 1
-                      
-      do i=i1 +  coeffraf, i2 - coeffraf,coeffraf     
-        slope = vanleer(x(locind_parent_left-1:locind_parent_left+1))
-        slope = slope / coeffraf
-
-        do ii=i-coeffraf/2+diffmod,i+coeffraf/2
-          ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
-        enddo
-        locind_parent_left = locind_parent_left + 1
-      enddo
-      
-      i = i2
-      
-      if (locind_parent_left == np) then
-        slope=0.     
-      else
-        slope = vanleer(x(locind_parent_left-1:locind_parent_left+1))
-        slope = slope / coeffraf      
-      endif
-      
-        do ii=i-coeffraf/2+diffmod,nc
-          ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
-        enddo      
-C
-      y(1:nc)=ytemp(1:nc)                                   
-C           
-      deallocate(ytemp)
-      Return
-C       
-      End Subroutine Linear1dconservlim      
-C         
-
-C     **************************************************************************  
-CCC   Subroutine ppm1d
-C     ************************************************************************** 
-C 
-      Subroutine ppm1d(x,y,np,nc,
-     &                    s_parent,s_child,ds_parent,ds_child) 
-C
-CCC   Description:
-CCC   Subroutine to do a 1D interpolation and apply monotonicity constraints
-CCC   using piecewise parabolic method  
-CCC   on a child grid (vector y) from its parent grid (vector x).
-CC    Method:
-C
-C     Declarations:
-C
-      Implicit none
-C        
-C     Arguments
-      Integer             :: np,nc      
-      Real, INTENT(IN),Dimension(np) :: x      
-      Real, INTENT(OUT),Dimension(nc) :: y
-C      Real, Dimension(:),Allocatable :: ytemp
-      Real                :: s_parent,s_child,ds_parent,ds_child
-C
-C     Local scalars
-      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
-      Integer :: iparent,ipos,pos,nmin,nmax
-      Real    :: ypos
-      integer :: i1,jj
-      Real :: xpmin,a
-C      
-      Real :: xrmin,xrmax,am3,s2,s1  
-      Real, Dimension(np) :: xl,delta,a6,slope
-C      Real, Dimension(:),Allocatable  :: diff,diff2,diff3    
-      INTEGER :: diffmod
-      REAL :: invcoeffraf
-C      
-      coeffraf = nint(ds_parent/ds_child)
-C
-      If (coeffraf == 1) Then
-          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
-          return
-      End If
-      invcoeffraf = ds_child/ds_parent
-C      
-
-      IF( .NOT. allocated(tabtest4) ) THEN    
-      Allocate(tabtest4(-2*coeffraf:nc+2*coeffraf))
-      ELSE
-         IF (size(tabtest4) .LT. nc+4*coeffraf+1)THEN
-         deallocate( tabtest4 )
-         Allocate(tabtest4(-2*coeffraf:nc+2*coeffraf))
-         ENDIF
-      ENDIF
-            
-      ypos = s_child  
-C
-      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) 
-      locind_parent_last = 1 +
-     &      agrif_ceiling((ypos +(nc - 1) 
-     &      *ds_child - s_parent)/ds_parent)  
-C
-      xpmin = s_parent + (locind_parent_left-1)*ds_parent       
-      i1 = 1+agrif_int((xpmin-s_child)/ds_child)        
-C     
-C
-      
-!CDIR NOVECTOR
-      Do i=1,coeffraf
-        tabdiff2(i)=(real(i)-0.5)*invcoeffraf
-      EndDo
-
-      a = invcoeffraf**2 
-      tabdiff3(1) = (1./3.)*a
-      a=2.*a
-!CDIR NOVECTOR
-      Do i=2,coeffraf
-        tabdiff3(i) = tabdiff3(i-1)+(real(i)-1)*a
-      EndDo
-C
-      if( locind_parent_last+2 <= np ) then
-           nmax = locind_parent_last+2    
-      else if( locind_parent_last+1 <= np ) then
-           nmax = locind_parent_last+1
-      else
-           nmax = locind_parent_last 
-      endif     
-C      
-      if(locind_parent_left-1 >= 1) then
-          nmin = locind_parent_left-1
-      else 
-          nmin = locind_parent_left
-      endif    
-C 
-C
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-      Do i = nmin,nmax
-         slope(i) = x(i) - x(i-1)
-      Enddo
-
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-      Do i = nmin+1,nmax-1
-         xl(i)= 0.5*(x(i-1)+x(i))
-     &      -0.08333333333333*(slope(i+1)-slope(i-1)) 
-      Enddo
-C
-C apply parabolic monotonicity
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-       Do i = locind_parent_left,locind_parent_last
-          delta(i) = xl(i+1) - xl(i)
-          a6(i) = 6.*x(i)-3.*(xl(i) +xl(i+1))
-C
-       End do   
-C
-        diffmod = 0
-       IF (mod(coeffraf,2) == 0) diffmod = 1
-C
-        ipos = i1
-C               
-        Do iparent = locind_parent_left,locind_parent_last       
-             pos=1
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
-C
-               tabtest4(jj) = xl(iparent)   
-     &             + tabdiff2(pos) *  (delta(iparent)+a6(iparent))
-     &             - tabdiff3(pos) *  a6(iparent)
-               pos = pos+1 
-             End do 
-             ipos = ipos + coeffraf
-C
-        End do
-C
-C
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-        y(1:nc)=tabtest4(1:nc)
-        
-      Return
-      End Subroutine ppm1d
-      
-
-      Subroutine ppm1dprecompute2d(np2,np,nc,
-     &                    s_parent,s_child,ds_parent,ds_child,dir)
-C
-CCC   Description:
-CCC   Subroutine to compute 2D coefficients and index for a 1D interpolation
-CCC   using piecewise parabolic method  
-CC    Method: 
-C
-C     Declarations:
-C
-      Implicit none
-C        
-C     Arguments
-      Integer             :: np2,np,nc,dir
-C      Real, Dimension(:),Allocatable :: ytemp
-      Real                :: s_parent,s_child,ds_parent,ds_child
-C
-C     Local scalars
-      Integer, Dimension(:,:), Allocatable :: indparent_tmp
-      Integer, Dimension(:,:), Allocatable :: indchild_tmp
-      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
-      Integer :: iparent,ipos,pos,nmin,nmax
-      Real    :: ypos
-      integer :: i1,jj
-      Real :: xpmin,a
-C      
-      Real :: xrmin,xrmax,am3,s2,s1
-      Real, Dimension(np) :: xl,delta,a6,slope
-      INTEGER :: diffmod
-      REAL :: invcoeffraf
-C      
-      coeffraf = nint(ds_parent/ds_child)
-C
-      invcoeffraf = ds_child/ds_parent
-C 
-
-      if (.not.allocated(indparentppm)) then
-      allocate(
-     & indparentppm(np2*nc,3),
-     & indchildppm(np2*nc,3)
-     &        )
-      else
-      if (size(indparentppm,1)<np2*nc) then
-      allocate(
-     &  indparent_tmp(size(indparentppm,1),size(indparentppm,2)),
-     &  indchild_tmp(size(indparentppm,1),size(indparentppm,2)))
-      indparent_tmp = indparentppm 
-      indchild_tmp  = indchildppm 
-      deallocate(indparentppm,indchildppm)
-      allocate(
-     &indparentppm(np2*nc,3),
-     &indchildppm(np2*nc,3)
-     &        )
-      indparentppm(1:size(indparent_tmp,1),1:size(indparent_tmp,2))
-     & = indparent_tmp
-      indchildppm(1:size(indparent_tmp,1),1:size(indparent_tmp,2))
-     & = indchild_tmp
-      deallocate(indparent_tmp,indchild_tmp)
-      endif
-      endif
-
-      if (.not.allocated(indparentppm_1d)) then
-      allocate(indparentppm_1d(-2*coeffraf:nc+2*coeffraf),
-     &         indchildppm_1d(-2*coeffraf:nc+2*coeffraf))
-      else
-      if (size(indparentppm_1d)<nc+4*coeffraf+1) then
-      deallocate(indparentppm_1d,indchildppm_1d)
-      allocate(indparentppm_1d(-2*coeffraf:nc+2*coeffraf),
-     &         indchildppm_1d(-2*coeffraf:nc+2*coeffraf))
-      endif
-      endif
-
-
-      ypos = s_child
-C
-      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-      locind_parent_last = 1 +
-     &      agrif_ceiling((ypos +(nc - 1)
-     &      *ds_child - s_parent)/ds_parent)
-C
-      xpmin = s_parent + (locind_parent_left-1)*ds_parent
-      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
-C     
-C
-
-      Do i=1,coeffraf
-        tabdiff2(i)=(real(i)-0.5)*invcoeffraf
-      EndDo
-
-      a = invcoeffraf**2
-      tabdiff3(1) = (1./3.)*a
-      a=2.*a
-!CDIR ALTCODE
-      Do i=2,coeffraf
-        tabdiff3(i) = tabdiff3(i-1)+(real(i)-1)*a
-      EndDo
-
-!CDIR ALTCODE
-      Do i=1,coeffraf
-      tabppm(1,i,dir) = 0.08333333333333*
-     &              (-1.+4*tabdiff2(i)-3*tabdiff3(i))
-      tabppm(2,i,dir) = 0.08333333333333*
-     &              (7.-26.*tabdiff2(i)+18.*tabdiff3(i))
-      tabppm(3,i,dir) = 0.08333333333333*
-     &              (7.+30*tabdiff2(i)-30*tabdiff3(i))
-      tabppm(4,i,dir) = 0.08333333333333*
-     &              (-1.-10.*tabdiff2(i)+18.*tabdiff3(i))
-      tabppm(5,i,dir) = 0.08333333333333*
-     &              (2*tabdiff2(i)-3*tabdiff3(i))                   
-      End Do
-C 
-C
-        diffmod = 0
-       IF (mod(coeffraf,2) == 0) diffmod = 1
-C
-        ipos = i1
-C               
-        Do iparent = locind_parent_left,locind_parent_last
-             pos=1
-!CDIR ALTCODE
-             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
-         indparentppm_1d(jj) = iparent-2
-         indchildppm_1d(jj) = pos
-               pos = pos+1
-             End do
-             ipos = ipos + coeffraf
-C
-        End do
-     
-       Do i=1,np2
-
-       indparentppm(1+(i-1)*nc:i*nc,dir) = 
-     &             indparentppm_1d(1:nc) + (i-1)*np
-       indchildppm (1+(i-1)*nc:i*nc,dir) = 
-     &             indchildppm_1d (1:nc) 
-
-       End do
-
-      Return
-      End Subroutine ppm1dprecompute2d
-
-
-      Subroutine ppm1dprecompute(np,nc,
-     &                    s_parent,s_child,ds_parent,ds_child) 
-C
-CCC   Description:
-CCC   Subroutine to compute coefficient and index for  a 1D interpolation 
-CCC   using piecewise parabolic method  
-CC    Method:
-C
-C     Declarations:
-C
-      Implicit none
-C        
-C     Arguments
-      Integer             :: np,nc
-C      Real, Dimension(:),Allocatable :: ytemp
-      Real                :: s_parent,s_child,ds_parent,ds_child
-C
-C     Local scalars
-      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
-      Integer :: iparent,ipos,pos,nmin,nmax
-      Real    :: ypos
-      integer :: i1,jj
-      Real :: xpmin,a
-C      
-      Real :: xrmin,xrmax,am3,s2,s1  
-      Real, Dimension(np) :: xl,delta,a6,slope
-C      Real, Dimension(:),Allocatable  :: diff,diff2,diff3    
-      INTEGER :: diffmod
-      REAL :: invcoeffraf
-C      
-      coeffraf = nint(ds_parent/ds_child)
-C
-      If (coeffraf == 1) Then
-          return
-      End If
-      invcoeffraf = ds_child/ds_parent
-C 
-      
-      if (.not.allocated(indparentppm)) then
-      allocate(indparentppm(-2*coeffraf:nc+2*coeffraf,1),
-     &         indchildppm(-2*coeffraf:nc+2*coeffraf,1))
-      else
-      if (size(indparentppm,1)<nc+4*coeffraf+1) then
-      deallocate(indparentppm,indchildppm)
-      allocate(indparentppm(-2*coeffraf:nc+2*coeffraf,1),
-     &         indchildppm(-2*coeffraf:nc+2*coeffraf,1))
-      endif
-      endif
-            
-      ypos = s_child  
-C
-      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) 
-      locind_parent_last = 1 +
-     &      agrif_ceiling((ypos +(nc - 1) 
-     &      *ds_child - s_parent)/ds_parent)  
-C
-      xpmin = s_parent + (locind_parent_left-1)*ds_parent       
-      i1 = 1+agrif_int((xpmin-s_child)/ds_child)        
-C     
-C
-      
-      Do i=1,coeffraf
-        tabdiff2(i)=(real(i)-0.5)*invcoeffraf
-      EndDo
-
-      a = invcoeffraf**2 
-      tabdiff3(1) = (1./3.)*a
-      a=2.*a
-!CDIR ALTCODE
-!!!CDIR SHORTLOOP
-      Do i=2,coeffraf
-        tabdiff3(i) = tabdiff3(i-1)+(real(i)-1)*a
-      EndDo
-      
-!CDIR ALTCODE
-!!!CDIR SHORTLOOP
-      Do i=1,coeffraf
-      tabppm(1,i,1) = 0.08333333333333*(-1.+4*tabdiff2(i)-3*tabdiff3(i))
-      tabppm(2,i,1) = 0.08333333333333*
-     &              (7.-26.*tabdiff2(i)+18.*tabdiff3(i))
-      tabppm(3,i,1) =0.08333333333333*(7.+30*tabdiff2(i)-30*tabdiff3(i))
-      tabppm(4,i,1) = 0.08333333333333*
-     &              (-1.-10.*tabdiff2(i)+18.*tabdiff3(i))     
-      tabppm(5,i,1) = 0.08333333333333*(2*tabdiff2(i)-3*tabdiff3(i)) 
-      End Do   
-C 
-C
-        diffmod = 0
-       IF (mod(coeffraf,2) == 0) diffmod = 1
-C
-        ipos = i1
-C               
-        Do iparent = locind_parent_left,locind_parent_last       
-             pos=1
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
-         indparentppm(jj,1) = iparent-2
-         indchildppm(jj,1) = pos
-               pos = pos+1 
-             End do 
-             ipos = ipos + coeffraf
-C
-        End do
-        
-      Return
-      End Subroutine ppm1dprecompute
-      
-      Subroutine ppm1daftercompute(x,y,np,nc,
-     &                    s_parent,s_child,ds_parent,ds_child,dir) 
-C
-CCC   Description:
-CCC   Subroutine to do a 1D interpolation and apply monotonicity constraints
-CCC   using piecewise parabolic method  
-CCC   on a child grid (vector y) from its parent grid (vector x).
-CC    Method: Use precomputed coefficient and index
-C
-C     Declarations:
-C
-      Implicit none
-C        
-C     Arguments
-      Integer             :: np,nc,dir
-      Real, INTENT(IN),Dimension(np) :: x      
-      Real, INTENT(OUT),Dimension(nc) :: y
-C      Real, Dimension(:),Allocatable :: ytemp
-      Real                :: s_parent,s_child,ds_parent,ds_child
-C
-C     Local scalars
-      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
-      Integer :: iparent,ipos,pos,nmin,nmax
-      Real    :: ypos
-      integer :: i1,jj
-      Real :: xpmin,a
-C      
-      Real :: xrmin,xrmax,am3,s2,s1  
-      Real, Dimension(np) :: xl,delta,a6,slope
-      INTEGER :: diffmod
-C      
-C
-      do i=1,nc
-      y(i)=tabppm(1,indchildppm(i,dir),dir)*x(indparentppm(i,dir))+
-     &        tabppm(2,indchildppm(i,dir),dir)*x(indparentppm(i,dir)+1)+
-     &        tabppm(3,indchildppm(i,dir),dir)*x(indparentppm(i,dir)+2)+
-     &        tabppm(4,indchildppm(i,dir),dir)*x(indparentppm(i,dir)+3)+
-     &        tabppm(5,indchildppm(i,dir),dir)*x(indparentppm(i,dir)+4)
-      enddo
-        
-      Return
-      End Subroutine ppm1daftercompute            
-      
-C     **************************************************************************  
-CCC   Subroutine weno1d
-C     ************************************************************************** 
-C 
-      Subroutine weno1dnew(x,y,np,nc,
-     &                    s_parent,s_child,ds_parent,ds_child) 
-C
-CCC   Description:
-CCC   Subroutine to do a 1D interpolation and apply monotonicity constraints
-CCC   using piecewise parabolic method  
-CCC   on a child grid (vector y) from its parent grid (vector x).
-CC    Method:
-C
-C     Declarations:
-C
-      Implicit none
-C        
-C     Arguments
-      Integer             :: np,nc
-      Real, Dimension(np) :: x
-      Real, Dimension(nc) :: y
-      Real, Dimension(:),Allocatable :: ytemp
-      Real                :: s_parent,s_child,ds_parent,ds_child
-C
-C     Local scalars
-      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
-      Integer :: iparent,ipos,pos,nmin,nmax
-      Real    :: ypos
-      integer :: i1,jj
-      Real :: xpmin,cavg,a,b
-C      
-      Real :: xrmin,xrmax,am3,s2,s1
-      Real, Dimension(np) :: xr,xl,delta,a6,slope,slope2,smooth
-      Real, Dimension(:),Allocatable  :: diff,diff2,diff3
-      INTEGER :: diffmod
-      REAL :: invcoeffraf
-      integer :: s,l,k
-      integer :: etan, etap
-      real :: delta0, delta1, delta2
-      real :: epsilon
-      parameter (epsilon = 1.D-8)
-      real, dimension(:,:), allocatable :: ak, ck
-C      
-      coeffraf = nint(ds_parent/ds_child)
-C
-      If (coeffraf == 1) Then
-          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
-          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
-          return
-      End If
-      invcoeffraf = ds_child/ds_parent
-      Allocate(ak(0:1,coeffraf))
-      Allocate(ck(0:1,coeffraf))
-            
-C      
-      Allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
-      ypos = s_child
-C
-      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-      locind_parent_last = 1 +
-     &      agrif_ceiling((ypos +(nc - 1)
-     &      *ds_child - s_parent)/ds_parent)
-C
-      xpmin = s_parent + (locind_parent_left-1)*ds_parent
-      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
-C     
-      Allocate( diff(coeffraf),diff2(coeffraf),diff3(coeffraf) )
-C      
-      diff(1)=0.5*invcoeffraf
-      do i=2,coeffraf
-         diff(i) = diff(i-1)+invcoeffraf
-      enddo
-      
-      ak = 0.
-      ck = 0.
-      
-      do i=1,coeffraf
-         do k=0,1
-         do s=0,2
-         do l=0,2
-           if (l /= s) then
-            ak(k,i) = ak(k,i)+(diff(i)-(k-l+1.))
-           endif
-         enddo
-         enddo
-         enddo
-               
-         etap = 0
-         etan = 0
-         do k=0,1
-          if (ak(k,i) > 0) then
-            etap = etap+1
-          else if (ak(k,i) < 0) then
-            etan = etan + 1
-          endif
-         enddo
-               
-         do k=0,1
-           if (ak(k,i) == 0) then
-            Ck(k,i) = 1.
-           else if (ak(k,i) > 0) then
-            Ck(k,i) = 1./(etap * ak(k,i))
-           else
-            Ck(k,i) = -1./(etan * ak(k,i))
-           endif
-         enddo
-      enddo
-                     
-C      
-      a = 0.
-      b = invcoeffraf
-      Do i=1,coeffraf
-         diff2(i) = 0.5*(b*b - a*a)  
-         diff3(i) = (1./3.)*(b*b*b - a*a*a)
-         a = a + invcoeffraf
-         b = b + invcoeffraf
-      End do
-C
-      if( locind_parent_last+2 <= np ) then
-           nmax = locind_parent_last+2    
-      elseif( locind_parent_last+1 <= np ) then
-           nmax = locind_parent_last+1
-      else
-           nmax = locind_parent_last 
-      endif     
-C      
-      if(locind_parent_left-2 >= 1) then
-          nmin = locind_parent_left-2
-      elseif(locind_parent_left-1 >= 1) then
-          nmin = locind_parent_left-1
-      else 
-          nmin = locind_parent_left
-      endif    
-C 
-      Do i = nmin+1,nmax
-         slope(i) = (x(i) - x(i-1))
-      Enddo 
-      DO i=nmin+2,nmax
-        smooth(i) = 0.5*(slope(i)**2+slope(i-1)**2)
-     &       +(slope(i)-slope(i-1))**2
-      enddo
-C
-        diffmod = 0
-        IF (mod(coeffraf,2) == 0) diffmod = 1           
-C
-        ipos = i1
-C               
-        Do iparent = locind_parent_left,locind_parent_last       
-             pos=1
-             
-            delta0=1./(epsilon+smooth(iparent  ))**3
-            delta1=1./(epsilon+smooth(iparent+1))**3
-            delta2=1./(epsilon+smooth(iparent+2))**3   
-                      
-             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
-C
-               pos = pos+1 
-             End do 
-             ipos = ipos + coeffraf
-C
-        End do     
-C
-C
-        y(1:nc)=ytemp(1:nc)                                 
-        deallocate(ytemp)                
-        deallocate(diff, diff2, diff3)
-        
-        deallocate(ak,ck)
-        
-      Return
-      End Subroutine weno1dnew
-      
-C     **************************************************************************  
-CCC   Subroutine weno1d
-C     ************************************************************************** 
-C 
-      Subroutine weno1d(x,y,np,nc,
-     &                    s_parent,s_child,ds_parent,ds_child) 
-C
-CCC   Description:
-CCC   Subroutine to do a 1D interpolation and apply monotonicity constraints
-CCC   using piecewise parabolic method  
-CCC   on a child grid (vector y) from its parent grid (vector x).
-CC    Method:
-C
-C     Declarations:
-C
-      Implicit none
-C        
-C     Arguments
-      Integer             :: np,nc
-      Real, Dimension(np) :: x
-      Real, Dimension(nc) :: y
-      Real, Dimension(:),Allocatable :: ytemp
-      Real                :: s_parent,s_child,ds_parent,ds_child
-C
-C     Local scalars
-      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
-      Integer :: iparent,ipos,pos,nmin,nmax
-      Real    :: ypos
-      integer :: i1,jj
-      Real :: xpmin,cavg,a,b
-C      
-      Real :: xrmin,xrmax,am3,s2,s1
-      Real, Dimension(np) :: xr,xl,delta,a6,slope,slope2
-      Real, Dimension(:),Allocatable  :: diff,diff2,diff3
-      INTEGER :: diffmod
-      REAL :: invcoeffraf
-      integer :: s,l,k
-      integer :: etan, etap
-      real :: delta0, delta1,sumdelta
-      real :: epsilon
-      parameter (epsilon = 1.D-8)
-C      
-      coeffraf = nint(ds_parent/ds_child)
-C
-      If (coeffraf == 1) Then
-          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
-          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
-          return
-      End If
-      invcoeffraf = ds_child/ds_parent
-            
-C      
-      Allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
-      ypos = s_child
-C
-      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-      locind_parent_last = 1 +
-     &      agrif_ceiling((ypos +(nc - 1)
-     &      *ds_child - s_parent)/ds_parent)
-C
-      xpmin = s_parent + (locind_parent_left-1)*ds_parent
-      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
-C     
-      Allocate( diff(coeffraf))
-C      
-      diff(1)=0.5*invcoeffraf
-      do i=2,coeffraf
-         diff(i) = diff(i-1)+invcoeffraf
-      enddo
-C
-      if( locind_parent_last+2 <= np ) then
-           nmax = locind_parent_last+2   
-      else if( locind_parent_last+1 <= np ) then
-           nmax = locind_parent_last+1
-      else
-           nmax = locind_parent_last 
-      endif     
-C      
-      if(locind_parent_left-1 >= 1) then
-          nmin = locind_parent_left-1
-      else 
-          nmin = locind_parent_left
-      endif    
-C 
-      Do i = nmin+1,nmax
-         slope(i) = (x(i) - x(i-1))
-      Enddo 
-C
-        diffmod = 0
-        IF (mod(coeffraf,2) == 0) diffmod = 1           
-C
-        ipos = i1
-C               
-        Do iparent = locind_parent_left,locind_parent_last       
-             pos=1
-            delta0=1./(epsilon+slope(iparent  )**2)**2
-            delta1=1./(epsilon+slope(iparent+1)**2)**2
-            sumdelta = 1./(delta0+delta1)             
-             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
-C                              
-          ytemp(jj) = x(iparent)+(diff(pos)-0.5)*(
-     &                delta0*slope(iparent)+
-     &                delta1*slope(iparent+1))*sumdelta
-               pos = pos+1 
-             End do 
-             ipos = ipos + coeffraf
-C
-        End do     
-C
-C
-        y(1:nc)=ytemp(1:nc)                                 
-        deallocate(ytemp)                
-        deallocate(diff)
-        
-      Return
-      End Subroutine weno1d
-                 
-C                              
-C     **************************************************************************  
-CCC   Subroutine eno1d
-C     ************************************************************************** 
-C 
-      Subroutine eno1d(x,y,np,nc,
-     &                    s_parent,s_child,ds_parent,ds_child) 
-C
-CCC   Description:
-CCC   ---- p 163-164 Computational gasdynamics ----
-CCC   Subroutine to do a 1D interpolation 
-CCC   using piecewise polynomial ENO reconstruction technique  
-CCC   on a child grid (vector y) from its parent grid (vector x).
-CC    Method:
-C
-C     Declarations:
-C
-      Implicit none
-C        
-C     Arguments
-      Integer             :: np,nc      
-      Real, Dimension(np) :: x      
-      Real, Dimension(nc) :: y
-      Real, Dimension(:),Allocatable :: ytemp
-      Real                :: s_parent,s_child,ds_parent,ds_child
-C
-C     Local scalars
-      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
-      Integer :: ipos,pos
-      Real    :: ypos,xi
-      integer :: i1,jj
-      Real :: xpmin,cavg
-C 
-      Real, Dimension(3,np) :: dd,c
-      Integer :: left
-C           
-      Real, DImension(1:np+1) :: xhalf
-      Real, Dimension(:,:),Allocatable  :: Xbar 
-      INTEGER :: diffmod     
-C
-      coeffraf = nint(ds_parent/ds_child)
-C      
-      If (coeffraf == 1) Then
-          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
-          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
-          return
-      End If     
-      
-      diffmod = 0
-      IF (mod(coeffraf,2) == 0) diffmod = 1  
-C      
-      Allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
-      ypos = s_child  
-      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) 
-      locind_parent_last = 1 +
-     &      agrif_ceiling((ypos +(nc - 1) *ds_child - 
-     &      s_parent)/ds_parent)       
-      xpmin = s_parent + (locind_parent_left-1)*ds_parent      
-      i1 = 1+agrif_int((xpmin-s_child)/ds_child)           
-C      
-      xhalf(np+1) = np + 0.5
-      Do i = 1,np
-          xhalf(i) = i - 0.5
-      Enddo
-C
-C compute divided differences
-C
-      dd(1,1:np) = x(1:np)
-      dd(2,1:np-1) = 0.5*( dd(1,2:np) - dd(1,1:np-1) )
-      dd(3,1:np-2) = (1./3.)*( dd(2,2:np-1) - dd(2,1:np-2) )
-C
-      Allocate( Xbar( coeffraf,2 ) )
-      xi = 0.5
-      Do i = 1,coeffraf
-        Xbar(i,1) = (i-1)*ds_child/ds_parent - xi
-        Xbar(i,2) = i*ds_child/ds_parent - xi
-      Enddo
-C
-      ipos = i1
-C           
-      DO i = locind_parent_left,locind_parent_last           
-         left = i           
-         do jj = 2,3
-             If(abs(dd(jj,left)) .gt. abs(dd(jj,left-1)))
-     &               left = left-1            
-         enddo
-C           
-C  convert to Taylor series form
-C
-         Call Taylor(i,xhalf(left:left+2),dd(1:3,left),c(1:3,i))
-      ENDDO     
-C
-C evaluate the reconstruction on each cell
-C
-       DO i = locind_parent_left,locind_parent_last  
-C
-         cavg = 0.
-         pos = 1.            
-C         
-         Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
-           ytemp(jj) =(c(1,i)*(Xbar(pos,2)-Xbar(pos,1))
-     &                +c(2,i)*(Xbar(pos,2)*Xbar(pos,2)-
-     &                         Xbar(pos,1)*Xbar(pos,1))
-     &                +c(3,i)*(Xbar(pos,2)*Xbar(pos,2)*Xbar(pos,2)-
-     &                         Xbar(pos,1)*Xbar(pos,1)*Xbar(pos,1)))
-     &                         *coeffraf
-           cavg = cavg + ytemp(jj)
-           pos = pos+1
-         Enddo                
-         ipos = ipos + coeffraf                 
-      ENDDO
-C
-      y(1:nc)=ytemp(1:nc)                                            
-      deallocate(ytemp,Xbar)                 
-C      
-      Return       
-      End Subroutine eno1d
-C 
-C      
-C     **************************************************************************  
-CCC   Subroutine taylor
-C     ************************************************************************** 
-C       
-      subroutine taylor(ind,xhalf,dd,c)      
-C      
-      Integer :: ind
-      real,dimension(3) :: dd,c     
-      real,dimension(0:3,0:3) :: d 
-      real,dimension(3) :: xhalf    
-      integer ::i,j
-C      
-C
-      d(0,0:3)=1.
-      do i = 1,3
-         d(i,0)=(ind-xhalf(i))*d(i-1,0)
-      enddo  
-C      
-      do i = 1,3
-         do j = 1,3-i
-           d(i,j) = d(i,j-1) + (ind-xhalf(i+j))*d(i-1,j)
-         enddo
-      enddo
-C         
-      do j = 1,3        
-         c(j) = 0.
-         do i=0,3-j
-            c(j) = c(j) + d(i,j)*dd(i+j)         
-         enddo
-      enddo
-C      
-      end subroutine taylor    
-      
-      
-      REAL FUNCTION vanleer(tab)
-      REAL, DIMENSION(3) :: tab
-       real res1
-       real p1,p2,p3
-       
-       p1=(tab(3)-tab(1))/2.
-       p2=2.*(tab(2)-tab(1))
-       p3=2.*(tab(3)-tab(2))
-       
-       if ((p1>0.).AND.(p2>0.).AND.(p3>0)) then
-          res1=minval((/p1,p2,p3/))
-       elseif ((p1<0.).AND.(p2<0.).AND.(p3<0)) then
-          res1=maxval((/p1,p2,p3/))
-       else
-          res1=0.
-       endif
-          
-          vanleer = res1   
-      
-      
-      END FUNCTION vanleer 
-
-C      
-      End Module Agrif_Interpbasic
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterpbasic.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterpbasic.F90	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterpbasic.F90	(revision 6440)
@@ -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: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modlinktomodel.F
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modlinktomodel.F	(revision 6439)
+++ 	(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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modlinktomodel.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modlinktomodel.F90	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modlinktomodel.F90	(revision 6440)
@@ -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: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmask.F
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmask.F	(revision 6439)
+++ 	(revision )
@@ -1,688 +1,0 @@
-!
-! $Id: modmask.F 2528 2010-12-27 17:33:53Z rblod $
-!
-C     AGRIF (Adaptive Grid Refinement In Fortran)
-C
-C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
-C
-C     This program is free software; you can redistribute it and/or modify
-C     it under the terms of the GNU General Public License as published by
-C     the Free Software Foundation; either version 2 of the License, or
-C     (at your option) any later version.
-C
-C     This program is distributed in the hope that it will be useful,
-C     but WITHOUT ANY WARRANTY; without even the implied warranty of
-C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-C     GNU General Public License for more details.
-C
-C     You should have received a copy of the GNU General Public License
-C     along with this program; if not, write to the Free Software
-C     Foundation, Inc., 59 Temple Place -  Suite 330, Boston, MA 02111-1307, USA.
-C
-C
-C
-CCC   Module Agrif_Mask
-C
-      Module Agrif_Mask
-C
-CCC   Description:
-CCC   Module for masks
-C
-C     Modules used: 
-C
-      Use Agrif_Types       
-C
-      IMPLICIT NONE
-C
-      CONTAINS
-C     Define procedures contained in this module
-C
-C     **************************************************************************
-C     Subroutine Agrif_CheckMasknD
-C     **************************************************************************
-C       
-      Subroutine Agrif_CheckMasknD(tempP,parent,pbtab,petab,ppbtab,
-     &               ppetab,noraftab,nbdim)
-C
-CCC   Description:
-CCC   Subroutine called in the procedure Agrif_InterpnD to recalculate the value 
-CCC   of the parent grid variable when this one is equal to Agrif_SpecialValue. 
-C
-C     Declarations:
-C
-       
-C
-C     Arrays arguments      
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(nbdim) :: pbtab  ! Limits of the parent grid used  
-      INTEGER,DIMENSION(nbdim) :: petab  ! interpolation of the child grid
-      LOGICAL,DIMENSION(nbdim) :: noraftab
-      INTEGER,DIMENSION(nbdim) :: ppbtab,ppetab
-C
-C     Pointer argument
-      TYPE(AGRIF_PVARIABLE) :: tempP  ! Part of the parent grid used for 
-                                      ! the interpolation of the child grid                     
-C     Data TYPE argument                                   
-      TYPE(AGRIF_PVARIABLE) :: parent      ! The parent grid
-C
-C     Local scalar
-      INTEGER                   :: i0,j0,k0,l0,m0,n0
-C      
-C     Local arrays
-C
-C      
-      SELECT CASE (nbdim)
-      CASE (1)
-         do i0 = pbtab(1),petab(1)
-         IF (tempP%var%array1(i0)
-     &                        == Agrif_SpecialValue) Then
-            Call CalculNewValTempP((/i0/),
-     &                             tempP,parent,
-     &                             ppbtab,ppetab,
-     &                             noraftab,nbdim)
-         ENDIF
-         enddo
-      CASE (2)
-         do j0 = pbtab(2),petab(2)
-         do i0 = pbtab(1),petab(1)
-         IF (tempP%var%array2(i0,j0)
-     &                        == Agrif_SpecialValue) Then
-            Call CalculNewValTempP((/i0,j0/),
-     &                             tempP,parent,
-     &                             ppbtab,ppetab,
-     &                             noraftab,nbdim)
-         ENDIF
-         enddo  
-         enddo
-      CASE (3)
-         do k0 = pbtab(3),petab(3)
-         do j0 = pbtab(2),petab(2)
-         do i0 = pbtab(1),petab(1)
-         IF (tempP%var%array3(i0,j0,k0)
-     &                        == Agrif_SpecialValue) Then
-!------CDIR NEXPAND
-            Call CalculNewValTempP3D((/i0,j0,k0/),
-     &      tempP%var%array3(ppbtab(1),ppbtab(2),ppbtab(3)),
-     &      parent%var%array3(ppbtab(1),ppbtab(2),ppbtab(3)),
-     &                           ppbtab,ppetab,
-     &                           noraftab,MaxSearch,Agrif_SpecialValue)
-     
-c            Call CalculNewValTempP((/i0,j0,k0/),
-c     &                             tempP,parent,
-c     &                             ppbtab,ppetab,
-c     &                             noraftab,nbdim)
-          
-         ENDIF
-         enddo
-         enddo  
-         enddo
-      CASE (4)
-         do l0 = pbtab(4),petab(4)
-         do k0 = pbtab(3),petab(3)
-         do j0 = pbtab(2),petab(2)
-         do i0 = pbtab(1),petab(1)
-         IF (tempP%var%array4(i0,j0,k0,l0) 
-     &                        == Agrif_SpecialValue) Then
-            Call CalculNewValTempP4D((/i0,j0,k0,l0/),
-     &      tempP%var%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)),
-     &      parent%var%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)),
-     &                           ppbtab,ppetab,
-     &                           noraftab,MaxSearch,Agrif_SpecialValue)
-         ENDIF
-         enddo
-         enddo
-         enddo  
-         enddo
-      CASE (5)
-         do m0 = pbtab(5),petab(5)
-         do l0 = pbtab(4),petab(4)
-         do k0 = pbtab(3),petab(3)
-         do j0 = pbtab(2),petab(2)
-         do i0 = pbtab(1),petab(1)
-         IF (tempP%var%array5(i0,j0,k0,l0,m0) 
-     &                       == Agrif_SpecialValue) Then
-            Call CalculNewValTempP((/i0,j0,k0,l0,m0/),
-     &                             tempP,parent,
-     &                             ppbtab,ppetab,
-     &                             noraftab,nbdim)
-         ENDIF
-         enddo
-         enddo
-         enddo  
-         enddo
-         enddo
-      CASE (6)
-         do n0 = pbtab(6),petab(6)
-         do m0 = pbtab(5),petab(5)
-         do l0 = pbtab(4),petab(4)
-         do k0 = pbtab(3),petab(3)
-         do j0 = pbtab(2),petab(2)
-         do i0 = pbtab(1),petab(1)
-         IF (tempP%var%array6(i0,j0,k0,l0,m0,n0) 
-     &                       == Agrif_SpecialValue) Then
-            Call CalculNewValTempP((/i0,j0,k0,l0,m0,n0/),
-     &                             tempP,parent,
-     &                             ppbtab,ppetab,
-     &                             noraftab,nbdim)
-         ENDIF
-         enddo
-         enddo
-         enddo
-         enddo  
-         enddo
-         enddo
-      END SELECT
-C
-C      
-C     
-      End Subroutine Agrif_CheckMasknD
-C
-C
-C     **************************************************************************
-C     Subroutine CalculNewValTempP
-C     **************************************************************************
-C       
-      Subroutine CalculNewValTempP(indic,
-     &               tempP,parent,ppbtab,
-     &               ppetab,noraftab,nbdim)
-C
-CCC   Description:
-CCC   Subroutine called in the procedure Agrif_InterpnD to recalculate the value 
-CCC   of the parent grid variable when this one is equal to Agrif_SpecialValue. 
-C
-C     Declarations:
-C
-       
-C
-C     Arrays arguments      
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(nbdim) :: indic
-      LOGICAL,DIMENSION(nbdim) :: noraftab
-      INTEGER,DIMENSION(nbdim) :: ppbtab,ppetab
-C
-C     Pointer argument
-      TYPE(AGRIF_PVARIABLE) :: tempP  ! Part of the parent grid used for 
-                                      ! the interpolation of the child grid                     
-C     Data TYPE argument                                   
-      TYPE(AGRIF_PVARIABLE) :: parent      ! The parent grid
-C
-C     Local scalar
-      INTEGER                  :: i,ii,iii,jj,kk,ll,mm,nn 
-      INTEGER,DIMENSION(nbdim) :: imin,imax,idecal
-      INTEGER                  :: Nbvals
-      REAL                     :: Res
-      REAL                     :: ValParent
-      INTEGER                  :: ValMax
-      LOGICAL                  :: firsttest
-C      
-C     Local arrays      
-C
-      ValMax = 1
-      do iii = 1 , nbdim
-         IF (.NOT.noraftab(iii)) THEN
-         ValMax = max(ValMax,ppetab(iii)-indic(iii))
-         ValMax = max(ValMax,indic(iii)-ppbtab(iii))
-         ENDIF
-      enddo
-C
-      Valmax = min(Valmax,MaxSearch)
-C
-!CDIR NOVECTOR
-      imin = indic
-!CDIR NOVECTOR
-      imax = indic
-C
-         i = 1
-         firsttest = .TRUE.
-C
-         do While(i <= ValMax)
-C
-         IF ((i == 1).AND.(firsttest)) i = Valmax
-
-            do iii = 1 , nbdim
-               if (.NOT.noraftab(iii)) then
-                  imin(iii) = max(indic(iii) - i,ppbtab(iii))
-                  imax(iii) = min(indic(iii) + i,ppetab(iii))
-                  if (firsttest) then               
-                  if (indic(iii).GT.ppbtab(iii)) then
-
-!CDIR NOVECTOR
-                     idecal = indic
-                     idecal(iii) = idecal(iii)-1
-                     SELECT CASE(nbdim)
-                     CASE (1)
-                        if (tempP%var%array1(idecal(1)
-     &                            ) == Agrif_SpecialValue) then
-                           imin(iii) = imax(iii)
-                        endif                     
-                     CASE (2)
-                        if (tempP%var%array2(idecal(1),
-     &            idecal(2)) == Agrif_SpecialValue) then
-                           imin(iii) = imax(iii)
-                        endif
-                     CASE (3)
-                        if (tempP%var%array3(idecal(1),
-     &            idecal(2),idecal(3)) 
-     &                               == Agrif_SpecialValue) then
-                           imin(iii) = imax(iii)
-                        endif  
-                     CASE (4)
-                        if (tempP%var%array4(idecal(1),
-     &            idecal(2),idecal(3),idecal(4)) 
-     &                               == Agrif_SpecialValue) then
-                           imin(iii) = imax(iii)
-                        endif     
-                     CASE (5)
-                        if (tempP%var%array5(idecal(1),
-     &            idecal(2),idecal(3),idecal(4),idecal(5)) 
-     &                               == Agrif_SpecialValue) then
-                           imin(iii) = imax(iii)
-                        endif  
-                     CASE (6)
-                        if (tempP%var%array6(idecal(1),
-     &            idecal(2),idecal(3),idecal(4),idecal(5),idecal(6)) 
-     &                               == Agrif_SpecialValue) then
-                           imin(iii) = imax(iii)
-                        endif                                                                                           
-                     END SELECT
-                  endif
-                  endif
-               endif            
-            enddo
-C
-            Res = 0.
-            Nbvals = 0
-C
-            SELECT CASE(nbdim)
-            CASE (1)
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-               do ii = imin(1),imax(1)
-                    ValParent = parent%var%array1(ii)
-                    if ( ValParent .NE. Agrif_SpecialValue) then
-                        Res = Res + ValParent
-                        Nbvals = Nbvals + 1
-                    endif 
-               enddo
-C
-            CASE (2)
-               do jj = imin(2),imax(2)
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-               do ii = imin(1),imax(1)
-                    ValParent = parent%var%array2(ii,jj)
-                    if ( ValParent .NE. Agrif_SpecialValue) then
-                        Res = Res + ValParent
-                        Nbvals = Nbvals + 1
-                    endif 
-               enddo  
-               enddo
-               
-            CASE (3)
-               do kk = imin(3),imax(3)
-               do jj = imin(2),imax(2)
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-               do ii = imin(1),imax(1)
-                    ValParent = parent%var%array3(ii,jj,kk)
-                    if ( ValParent .NE. Agrif_SpecialValue) then
-                        Res = Res + ValParent
-                        Nbvals = Nbvals + 1
-                    endif 
-                        enddo
-                  enddo  
-               enddo
-
-            CASE (4)
-               do ll = imin(4),imax(4)
-               do kk = imin(3),imax(3)
-               do jj = imin(2),imax(2)
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-               do ii = imin(1),imax(1)
-                    ValParent = parent%var%array4(ii,jj,kk,ll)
-                    if ( ValParent .NE. Agrif_SpecialValue) then
-                        Res = Res + ValParent
-                        Nbvals = Nbvals + 1
-                    endif 
-                              enddo
-                        enddo
-                  enddo  
-               enddo
-
-            CASE (5)
-               do mm = imin(5),imax(5)
-               do ll = imin(4),imax(4)
-               do kk = imin(3),imax(3)
-               do jj = imin(2),imax(2)
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-               do ii = imin(1),imax(1)
-                    ValParent = parent%var%array5(ii,jj,kk,ll,mm)
-                    if ( ValParent .NE. Agrif_SpecialValue) then
-                        Res = Res + ValParent
-                        Nbvals = Nbvals + 1
-                    endif 
-                                    enddo
-                              enddo
-                        enddo
-                  enddo  
-               enddo
-
-            CASE (6)
-               do nn = imin(6),imax(6)
-               do mm = imin(5),imax(5)
-               do ll = imin(4),imax(4)
-               do kk = imin(3),imax(3)
-               do jj = imin(2),imax(2)
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-               do ii = imin(1),imax(1)
-                    ValParent = parent%var%array6(ii,jj,kk,ll,mm,nn)
-                    if ( ValParent .NE. Agrif_SpecialValue) then
-                        Res = Res + ValParent
-                        Nbvals = Nbvals + 1
-                    endif 
-                                          enddo
-                                    enddo
-                              enddo
-                        enddo
-                  enddo  
-               enddo
-
-            END SELECT
-C
-C
-            
-            if (Nbvals.GT.0) then
-              if (firsttest) then
-                   firsttest = .FALSE.
-                   i=1
-                   cycle
-              endif
-            SELECT CASE(nbdim)
-            CASE (1)              
-              tempP%var%array1(indic(1)) 
-     &           = Res/Nbvals
-            CASE (2)
-              tempP%var%array2(indic(1),
-     &                            indic(2)) = Res/Nbvals
-            CASE (3)
-              tempP%var%array3(indic(1),
-     &                            indic(2),indic(3)) = Res/Nbvals
-            CASE (4)
-              tempP%var%array4(indic(1),
-     &                            indic(2),indic(3),indic(4))
-     &                = Res/Nbvals
-            CASE (5)
-              tempP%var%array5(indic(1),
-     &                            indic(2),indic(3),indic(4),
-     &                   indic(5)) = Res/Nbvals
-            CASE (6)
-              tempP%var%array6(indic(1),
-     &                            indic(2),indic(3),indic(4),
-     &                           indic(5),indic(6)) = Res/Nbvals
-            END SELECT
-              exit
-            else
-               if (firsttest) exit
-               i = i + 1                      
-            endif
-          enddo            
-C     
-      End Subroutine CalculNewValTempP
-C
-C
-      End Module Agrif_Mask     
-      
-      Subroutine CalculNewValTempP3D(indic,
-     &               tempP,parent,ppbtab,
-     &               ppetab,noraftab,MaxSearch,Agrif_SpecialValue)
-C
-CCC   Description:
-CCC   Subroutine called in the procedure Agrif_InterpnD to recalculate the value 
-CCC   of the parent grid variable when this one is equal to Agrif_SpecialValue. 
-C
-C     Declarations:
-C
-       
-C
-C     Arrays arguments      
-      INTEGER, PARAMETER :: nbdim = 3
-      INTEGER,DIMENSION(nbdim) :: indic
-      LOGICAL,DIMENSION(nbdim) :: noraftab
-      INTEGER,DIMENSION(nbdim) :: ppbtab,ppetab
-      REAL :: Agrif_SpecialValue
-C
-C     Pointer argument
-      REAL,DIMENSION(ppbtab(1):ppetab(1),ppbtab(2):ppetab(2),
-     &    ppbtab(3):ppetab(3)) :: tempP, parent  ! Part of the parent grid used for 
-                                      ! the interpolation of the child grid                     
-C
-C     Local scalar
-      INTEGER                  :: i,ii,iii,jj,kk,ll,mm,nn 
-      INTEGER,DIMENSION(nbdim) :: imin,imax,idecal
-      INTEGER                  :: Nbvals
-      REAL                     :: Res
-      REAL                     :: ValParent
-      INTEGER                  :: ValMax
-      INTEGER :: MaxSearch
-      LOGICAL :: Existunmasked
-C      
-C     Local arrays      
-C
-      ValMax = 1
-!CDIR NOVECTOR
-      do iii = 1 , nbdim
-         IF (.NOT.noraftab(iii)) THEN
-         ValMax = max(ValMax,ppetab(iii)-indic(iii))
-         ValMax = max(ValMax,indic(iii)-ppbtab(iii))
-         ENDIF
-      enddo
-C
-      Valmax = min(Valmax,MaxSearch)
-C
-!CDIR NOVECTOR
-      imin = indic
-!CDIR NOVECTOR
-      imax = indic
-      
-!CDIR NOVECTOR
-         idecal = indic	 
-C
-         i = Valmax
-
-            do iii = 1 , nbdim
-               if (.NOT.noraftab(iii)) then
-                  imin(iii) = max(indic(iii) - i,ppbtab(iii))
-                  imax(iii) = min(indic(iii) + i,ppetab(iii))
-         
-                  if (indic(iii).GT.ppbtab(iii)) then
-
-                     idecal(iii) = idecal(iii)-1
-
-                        if (tempP(idecal(1),idecal(2),idecal(3)) 
-     &                               == Agrif_SpecialValue) then
-                           imin(iii) = imax(iii)
-                        endif
-
-                     idecal(iii) = idecal(iii)+1
-                  endif
-
-               endif            
-            enddo
-C
-            Existunmasked = .FALSE.
-C
-               do kk = imin(3),imax(3)
-               do jj = imin(2),imax(2)
-!CDIR NOVECTOR
-               do ii = imin(1),imax(1)
-                    if ( parent(ii,jj,kk) .NE. Agrif_SpecialValue) then
-                        Existunmasked = .TRUE.
-                       exit
-                    endif 
-                        enddo
-                  enddo  
-               enddo
-C
-C
-          if (.Not.Existunmasked) return
-C
-         i = 1
-C
-         do While(i <= ValMax)
-C
-
-            do iii = 1 , nbdim
-               if (.NOT.noraftab(iii)) then
-                  imin(iii) = max(indic(iii) - i,ppbtab(iii))
-                  imax(iii) = min(indic(iii) + i,ppetab(iii))
-               endif            
-            enddo
-C
-            Res = 0.
-            Nbvals = 0
-C
-               do kk = imin(3),imax(3)
-               do jj = imin(2),imax(2)
-!CDIR NOVECTOR
-               do ii = imin(1),imax(1)
-                    ValParent = parent(ii,jj,kk)
-                    if ( ValParent .NE. Agrif_SpecialValue) then
-                        Res = Res + ValParent
-                        Nbvals = Nbvals + 1
-                    endif 
-                        enddo
-                  enddo  
-               enddo
-C
-C
-            
-            if (Nbvals.GT.0) then
-              tempP(indic(1),indic(2),indic(3)) = Res/Nbvals
-              exit
-            else
-               i = i + 1                      
-            endif
-          enddo            
-C     
-      End Subroutine CalculNewValTempP3D        
-
-      Subroutine CalculNewValTempP4D(indic,
-     &               tempP,parent,ppbtab,
-     &               ppetab,noraftab,MaxSearch,Agrif_SpecialValue)
-C
-CCC   Description:
-CCC   Subroutine called in the procedure Agrif_InterpnD to recalculate the value 
-CCC   of the parent grid variable when this one is equal to Agrif_SpecialValue. 
-C
-C     Declarations:
-C
-       
-C
-C     Arrays arguments      
-      INTEGER, PARAMETER :: nbdim = 4
-      INTEGER,DIMENSION(nbdim) :: indic
-      LOGICAL,DIMENSION(nbdim) :: noraftab
-      INTEGER,DIMENSION(nbdim) :: ppbtab,ppetab
-      INTEGER :: MaxSearch      
-      REAL :: Agrif_SpecialValue      
-C
-C     Pointer argument
-      REAL,DIMENSION(ppbtab(1):ppetab(1),ppbtab(2):ppetab(2),
-     &    ppbtab(3):ppetab(3),
-     &    ppbtab(4):ppetab(4)) :: tempP, parent  ! Part of the parent grid used for 
-                                      ! the interpolation of the child grid                     
-C
-C     Local scalar
-      INTEGER                  :: i,ii,iii,jj,kk,ll,mm,nn 
-      INTEGER,DIMENSION(nbdim) :: imin,imax,idecal
-      INTEGER                  :: Nbvals
-      REAL                     :: Res
-      REAL                     :: ValParent
-      INTEGER                  :: ValMax
-      LOGICAL                  :: firsttest
-C      
-C     Local arrays      
-C
-      ValMax = 1
-      do iii = 1 , nbdim
-         IF (.NOT.noraftab(iii)) THEN
-         ValMax = max(ValMax,ppetab(iii)-indic(iii))
-         ValMax = max(ValMax,indic(iii)-ppbtab(iii))
-         ENDIF
-      enddo
-C
-      Valmax = min(Valmax,MaxSearch)
-C
-      imin = indic
-      imax = indic
-C
-         i = 1
-         firsttest = .TRUE.
-         idecal = indic	 
-	 
-C
-         do While(i <= ValMax)
-C
-         IF ((i == 1).AND.(firsttest)) i = Valmax
-
-            do iii = 1 , nbdim
-               if (.NOT.noraftab(iii)) then
-                  imin(iii) = max(indic(iii) - i,ppbtab(iii))
-                  imax(iii) = min(indic(iii) + i,ppetab(iii))
-                  if (firsttest) then               
-                  if (indic(iii).GT.ppbtab(iii)) then
-
-
-                     idecal(iii) = idecal(iii)-1
-		     
-                     if (tempP(idecal(1),idecal(2),idecal(3),idecal(4))
-     &                               == Agrif_SpecialValue) then
-                           imin(iii) = imax(iii)
-                     endif
-		     
-		     idecal(iii) = idecal(iii)+1
-                  endif
-                  endif
-               endif            
-            enddo
-C
-            Res = 0.
-            Nbvals = 0
-C
-               do ll = imin(4),imax(4)
-               do kk = imin(3),imax(3)
-               do jj = imin(2),imax(2)
-               do ii = imin(1),imax(1)
-                    ValParent = parent(ii,jj,kk,ll)
-                    if ( ValParent .NE. Agrif_SpecialValue) then
-                        Res = Res + ValParent
-                        Nbvals = Nbvals + 1
-                    endif 
-                              enddo
-                        enddo
-                  enddo  
-               enddo
-C
-C
-            
-            if (Nbvals.GT.0) then
-              if (firsttest) then
-                   firsttest = .FALSE.
-                   i=1
-                   cycle
-              endif
-	      
-              tempP(indic(1),indic(2),indic(3),indic(4)) = Res/Nbvals
-	    
-              exit
-            else
-               if (firsttest) exit
-               i = i + 1                      
-            endif
-          enddo            
-C     
-      End Subroutine CalculNewValTempP4D        
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmask.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmask.F90	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmask.F90	(revision 6440)
@@ -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: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F	(revision 6439)
+++ 	(revision )
@@ -1,1119 +1,0 @@
-!
-! $Id: modmpp.F 2731 2011-04-08 12:05:35Z rblod $
-!
-C     AGRIF (Adaptive Grid Refinement In Fortran)
-C
-C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-C                        Christophe Vouland (Christophe.Vouland@imag.fr)
-C
-C     This program is free software; you can redistribute it and/or modify
-C     it under the terms of the GNU General Public License as published by
-C     the Free Software Foundation; either version 2 of the License, or
-C     (at your option) any later version.
-C
-C     This program is distributed in the hope that it will be useful,
-C     but WITHOUT ANY WARRANTY; without even the implied warranty of
-C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-C     GNU General Public License for more details.
-C
-C     You should have received a copy of the GNU General Public License
-C     along with this program; if not, write to the Free Software
-C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
-C
-C
-C
-CCC   Module Agrif_mpp
-C
-      Module Agrif_mpp
-      Use Agrif_Types
-      Use Agrif_Arrays
-
-      Contains
-#ifdef key_mpp_mpi
-      Subroutine Get_External_Data_first(pttruetab,
-     &   cetruetab,pttruetabwhole,cetruetabwhole,nbdim,memberin,
-     &   memberout,memberoutall1,sendtoproc,recvfromproc,imin,imax,
-     &   imin_recv,imax_recv)
-
-      IMPLICIT NONE
-      INCLUDE 'mpif.h'
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: pttruetab,
-     &                                                 cetruetab
-      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: pttruetabwhole,
-     &                                                 cetruetabwhole
-      INTEGER :: k,i,k2
-      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc, recvfromproc
-      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1):: imin,imax,
-     &   imin_recv,imax_recv
-      LOGICAL :: memberin, memberout
-      INTEGER :: imintmp, imaxtmp,j,i1
-      INTEGER :: imin1,imax1
-      LOGICAL :: tochange,tochangebis
-      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: pttruetab2,
-     &                                                 cetruetab2
-      LOGICAL :: memberout1(1),memberoutall(0:Agrif_Nbprocs-1)
-      LOGICAL, OPTIONAL :: memberoutall1(0:Agrif_Nbprocs-1)
-      INTEGER :: code
-      
-C pttruetab2 and cetruetab2 are modified arraysin order to always
-C send the most inner points
-
-        
-        IF (present(memberoutall1)) THEN
-        memberoutall = memberoutall1
-        ELSE
-         memberout1(1) = memberout
-
-         CALL MPI_ALLGATHER(memberout1,1,MPI_LOGICAL,memberoutall,
-     &                  1,MPI_LOGICAL,MPI_COMM_AGRIF,code)
-        ENDIF
-         pttruetab2(:,Agrif_Procrank) = pttruetab(:,Agrif_Procrank)
-         cetruetab2(:,Agrif_Procrank) = cetruetab(:,Agrif_Procrank)
-         do k2=0,Agrif_Nbprocs-1
-            do i=1,nbdim
-
-           tochangebis=.TRUE.
-           DO i1=1,nbdim
-            IF (i .NE. i1) THEN
-              IF ((pttruetab(i1,Agrif_Procrank).NE.pttruetab(i1,k2)).OR.
-     &          (cetruetab(i1,Agrif_Procrank).NE.cetruetab(i1,k2))) THEN
-                   tochangebis = .FALSE.
-               EXIT
-              ENDIF
-             ENDIF
-           ENDDO
-
-           IF (tochangebis) THEN
-
-
-          imin1 = max(pttruetab(i,Agrif_Procrank),
-     &                    pttruetab(i,k2))
-          imax1 = min(cetruetab(i,Agrif_Procrank),
-     &                    cetruetab(i,k2))
-
-C Always send the most interior points
-
-           tochange = .false.
-           IF (cetruetab(i,Agrif_Procrank)> cetruetab(i,k2)) THEN
-
-           DO j=imin1,imax1
-             IF ((cetruetab(i,k2)-j) >
-     &             (j-pttruetab(i,Agrif_Procrank))) THEN
-             imintmp = j+1
-             tochange = .TRUE.
-             ELSE
-              EXIT
-             ENDIF
-          ENDDO
-          ENDIF
-
-           if (tochange) then
-C
-              pttruetab2(i,Agrif_Procrank) = imintmp
-C
-          endif
-
-           tochange = .FALSE.
-           imaxtmp=0
-           IF (pttruetab(i,Agrif_Procrank) < pttruetab(i,k2)) THEN
-          DO j=imax1,imin1,-1
-            IF ((j-pttruetab(i,k2)) >
-     &             (cetruetab(i,Agrif_Procrank)-j)) THEN
-             imaxtmp = j-1
-             tochange = .TRUE.
-            ELSE
-             EXIT
-            ENDIF
-          ENDDO
-
-          ENDIF
-
-                    if (tochange) then
-C
-              cetruetab2(i,Agrif_Procrank) = imaxtmp
-C
-          endif
-C
-
-          ENDIF
-           enddo
-         enddo
-
-
-       do k = 0,Agrif_NbProcs-1
-C
-        sendtoproc(k) = .true.
-C
-!CDIR SHORTLOOP
-        do i = 1,nbdim
-C
-          imin(i,k) = max(pttruetab2(i,Agrif_Procrank),
-     &                    pttruetabwhole(i,k))
-          imax(i,k) = min(cetruetab2(i,Agrif_Procrank),
-     &                    cetruetabwhole(i,k))
-C
-          if (imin(i,k) > imax(i,k)) then
-C
-              sendtoproc(k) = .false.
-C
-          endif
-C
-        enddo
-        IF (.NOT.memberoutall(k)) THEN
-           sendtoproc(k) = .FALSE.
-        ENDIF
-C
-      enddo
-      
-      Call Exchangesamelevel_first(sendtoproc,nbdim,imin,imax,
-     &     recvfromproc,imin_recv,imax_recv)
-      
-      End Subroutine Get_External_Data_first
-C
-      Subroutine Get_External_Data(tempC,tempCextend,pttruetab,
-     &   cetruetab,pttruetabwhole,cetruetabwhole,nbdim,memberin,
-     &   memberout,memberoutall1)
-
-      IMPLICIT NONE
-      INCLUDE 'mpif.h'
-      INTEGER :: nbdim
-      TYPE(Agrif_PVariable) :: tempC, tempCextend
-      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: pttruetab,
-     &                                                 cetruetab
-      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: pttruetabwhole,
-     &                                                 cetruetabwhole
-      INTEGER :: k,i,k2
-      LOGICAL :: sendtoproc(0:Agrif_Nbprocs-1)
-      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: imin,imax
-      LOGICAL :: memberin, memberout
-      INTEGER :: imintmp, imaxtmp,j,i1
-      INTEGER :: imin1,imax1
-      LOGICAL :: tochange,tochangebis
-      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: pttruetab2,
-     &                                                 cetruetab2
-      LOGICAL :: memberout1(1),memberoutall(0:Agrif_Nbprocs-1)
-      LOGICAL, OPTIONAL :: memberoutall1(0:Agrif_Nbprocs-1)
-      INTEGER :: code
-
-C pttruetab2 and cetruetab2 are modified arraysin order to always
-C send the most inner points
-
-        
-        IF (present(memberoutall1)) THEN
-        memberoutall = memberoutall1
-        ELSE
-         memberout1(1) = memberout
-
-         CALL MPI_ALLGATHER(memberout1,1,MPI_LOGICAL,memberoutall,
-     &                  1,MPI_LOGICAL,MPI_COMM_AGRIF,code)
-        ENDIF
-         pttruetab2(:,Agrif_Procrank) = pttruetab(:,Agrif_Procrank)
-         cetruetab2(:,Agrif_Procrank) = cetruetab(:,Agrif_Procrank)
-         do k2=0,Agrif_Nbprocs-1
-            do i=1,nbdim
-
-           tochangebis=.TRUE.
-           DO i1=1,nbdim
-            IF (i .NE. i1) THEN
-              IF ((pttruetab(i1,Agrif_Procrank).NE.pttruetab(i1,k2)).OR.
-     &          (cetruetab(i1,Agrif_Procrank).NE.cetruetab(i1,k2))) THEN
-                   tochangebis = .FALSE.
-               EXIT
-              ENDIF
-             ENDIF
-           ENDDO
-
-           IF (tochangebis) THEN
-
-
-          imin1 = max(pttruetab(i,Agrif_Procrank),
-     &                    pttruetab(i,k2))
-          imax1 = min(cetruetab(i,Agrif_Procrank),
-     &                    cetruetab(i,k2))
-
-C Always send the most interior points
-
-           tochange = .false.
-           IF (cetruetab(i,Agrif_Procrank)> cetruetab(i,k2)) THEN
-
-           DO j=imin1,imax1
-             IF ((cetruetab(i,k2)-j) >
-     &             (j-pttruetab(i,Agrif_Procrank))) THEN
-             imintmp = j+1
-             tochange = .TRUE.
-             ELSE
-              EXIT
-             ENDIF
-          ENDDO
-          ENDIF
-
-           if (tochange) then
-C
-              pttruetab2(i,Agrif_Procrank) = imintmp
-C
-          endif
-
-           tochange = .FALSE.
-           imaxtmp=0
-           IF (pttruetab(i,Agrif_Procrank) < pttruetab(i,k2)) THEN
-          DO j=imax1,imin1,-1
-            IF ((j-pttruetab(i,k2)) >
-     &             (cetruetab(i,Agrif_Procrank)-j)) THEN
-             imaxtmp = j-1
-             tochange = .TRUE.
-            ELSE
-             EXIT
-            ENDIF
-          ENDDO
-
-          ENDIF
-
-                    if (tochange) then
-C
-              cetruetab2(i,Agrif_Procrank) = imaxtmp
-C
-          endif
-C
-
-          ENDIF
-           enddo
-         enddo
-
-
-       do k = 0,Agrif_NbProcs-1
-C
-        sendtoproc(k) = .true.
-C
-!CDIR SHORTLOOP
-        do i = 1,nbdim
-C
-          imin(i,k) = max(pttruetab2(i,Agrif_Procrank),
-     &                    pttruetabwhole(i,k))
-          imax(i,k) = min(cetruetab2(i,Agrif_Procrank),
-     &                    cetruetabwhole(i,k))
-C
-          if (imin(i,k) > imax(i,k)) then
-C
-              sendtoproc(k) = .false.
-C
-          endif
-C
-        enddo
-        IF (.NOT.memberoutall(k)) THEN
-           sendtoproc(k) = .FALSE.
-        ENDIF
-C
-      enddo
-
-
-c       IF (.NOT.memberin) sendtoproc = .FALSE.
-
-      IF (memberout) THEN
-      Call Agrif_nbdim_allocation(tempCextend%var,
-     &                 pttruetabwhole(:,Agrif_ProcRank),
-     &                 cetruetabwhole(:,Agrif_ProcRank),nbdim)
-      call Agrif_nbdim_Full_VarEQreal(tempCextend%var,0.,nbdim)
-      ENDIF
-
-      IF (sendtoproc(Agrif_ProcRank)) THEN
-           Call Agrif_nbdim_VarEQvar(tempCextend%var,
-     &                               imin(:,Agrif_Procrank),
-     &                               imax(:,Agrif_Procrank),
-     &                               tempC%var,
-     &                               imin(:,Agrif_Procrank),
-     &                               imax(:,Agrif_Procrank),
-     &                               nbdim)
-      ENDIF
-
-      Call Exchangesamelevel(sendtoproc,nbdim,imin,imax,tempC,
-     &     tempCextend)
-
-      End Subroutine Get_External_Data
-
-       Subroutine ExchangeSameLevel(sendtoproc,nbdim,imin,imax,
-     &          tempC,tempCextend)
-      Implicit None
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin,imax
-      INTEGER,DIMENSION(nbdim,2,0:Agrif_Nbprocs-1) :: iminmax_temp
-      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin_recv,imax_recv
-      TYPE(Agrif_PVARIABLE) :: tempC,tempCextend
-      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1)       :: sendtoproc
-      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1)       :: recvfromproc
-      LOGICAL                                    :: res
-      TYPE(AGRIF_PVARIABLE), SAVE                      :: temprecv
-
-      INCLUDE 'mpif.h'
-          INTEGER :: i,k
-          INTEGER :: etiquette = 100
-          INTEGER :: code, datasize
-          INTEGER,DIMENSION(MPI_STATUS_SIZE)   :: statut
-
-
-      do k = 0,Agrif_ProcRank-1
-C
-C
-            Call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette,
-     &                    MPI_COMM_AGRIF,code)
-C
-            if (sendtoproc(k)) then
-C
-                iminmax_temp(:,1,k) = imin(:,k)
-                iminmax_temp(:,2,k) = imax(:,k)
-
-                Call MPI_SEND(iminmax_temp(:,:,k),
-     &                        2*nbdim,MPI_INTEGER,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-C
-                datasize = 1
-C
-!CDIR SHORTLOOP
-                do i = 1,nbdim
-C
-                  datasize = datasize * (imax(i,k)-imin(i,k)+1)
-C
-                enddo
-C
-                SELECT CASE(nbdim)
-                CASE(1)
-                   Call MPI_SEND(tempC%var%array1(
-     &                        imin(1,k):imax(1,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(2)
-                   Call MPI_SEND(tempC%var%array2(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(3)
-                
-                  Call Agrif_Send_3Darray(tempC%var%array3,
-     &             lbound(tempC%var%array3),imin(:,k),imax(:,k),k)
-                CASE(4)
-                   Call MPI_SEND(tempC%var%array4(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(5)
-                   Call MPI_SEND(tempC%var%array5(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k),
-     &                        imin(5,k):imax(5,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(6)
-                   Call MPI_SEND(tempC%var%array6(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k),
-     &                        imin(5,k):imax(5,k),
-     &                        imin(6,k):imax(6,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                END SELECT
-C
-            endif
-
-C
-      enddo
-C
-C
-C     Reception from others processors of the necessary part of the parent grid
-      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
-C
-C
-            Call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette,
-     &                    MPI_COMM_AGRIF,statut,code)
-C
-            recvfromproc(k) = res
-
-C
-            if (recvfromproc(k)) then
-C
-                Call MPI_RECV(iminmax_temp(:,:,k),
-     &                        2*nbdim,MPI_INTEGER,k,etiquette,
-     &                        MPI_COMM_AGRIF,statut,code)
-
-                imin_recv(:,k) = iminmax_temp(:,1,k)
-                imax_recv(:,k) = iminmax_temp(:,2,k)
-
-                datasize = 1
-C
-!CDIR SHORTLOOP
-                do i = 1,nbdim
-C
-                datasize = datasize * (imax_recv(i,k)-imin_recv(i,k)+1)
-C
-                enddo
-
-             IF (.Not.Associated(temprecv%var)) allocate(temprecv%var)
-             call Agrif_nbdim_allocation(temprecv%var,imin_recv(:,k),
-     &   imax_recv(:,k),nbdim)
-            SELECT CASE(nbdim)
-            CASE(1)
-              Call MPI_RECV(temprecv%var%array1,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-            CASE(2)
-              Call MPI_RECV(temprecv%var%array2,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-            CASE(3)
-              Call MPI_RECV(temprecv%var%array3,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-
-            CASE(4)
-              Call MPI_RECV(temprecv%var%array4,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-            CASE(5)
-              Call MPI_RECV(temprecv%var%array5,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-            CASE(6)
-              Call MPI_RECV(temprecv%var%array6,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-       END SELECT
-                        
-            Call where_valtabtotab_mpi(tempCextend%var,
-     &             temprecv%var,imin_recv(:,k),imax_recv(:,k),0.,nbdim)
-     
-                Call Agrif_nbdim_deallocation(temprecv%var,nbdim)
-C                deallocate(temprecv%var)
-
-            endif
-
-C
-      enddo
-
-C     Reception from others processors of the necessary part of the parent grid
-      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
-C
-C
-            
-            Call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette,
-     &                    MPI_COMM_AGRIF,code)
-C
-            if (sendtoproc(k)) then
-C
-                iminmax_temp(:,1,k) = imin(:,k)
-                iminmax_temp(:,2,k) = imax(:,k)
-
-                Call MPI_SEND(iminmax_temp(:,:,k),
-     &                        2*nbdim,MPI_INTEGER,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-C
-                SELECT CASE(nbdim)
-                CASE(1)
-                datasize=SIZE(tempC%var%array1(
-     &                        imin(1,k):imax(1,k)))
-                   Call MPI_SEND(tempC%var%array1(
-     &                        imin(1,k):imax(1,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(2)
-                datasize=SIZE(tempC%var%array2(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k)))
-                   Call MPI_SEND(tempC%var%array2(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(3)
-                datasize=SIZE(tempC%var%array3(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k)))
-                   Call MPI_SEND(tempC%var%array3(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(4)
-                datasize=SIZE(tempC%var%array4(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k)))
-                   Call MPI_SEND(tempC%var%array4(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(5)
-                datasize=SIZE(tempC%var%array5(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k),
-     &                        imin(5,k):imax(5,k)))
-                   Call MPI_SEND(tempC%var%array5(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k),
-     &                        imin(5,k):imax(5,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(6)
-                datasize=SIZE(tempC%var%array6(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k),
-     &                        imin(5,k):imax(5,k),
-     &                        imin(6,k):imax(6,k)))
-                   Call MPI_SEND(tempC%var%array6(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k),
-     &                        imin(5,k):imax(5,k),
-     &                        imin(6,k):imax(6,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                END SELECT
-C
-            endif
-
-C
-      enddo
-C
-C
-C     Reception from others processors of the necessary part of the parent grid
-      do k = Agrif_ProcRank-1,0,-1
-C
-C
-            Call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette,
-     &                    MPI_COMM_AGRIF,statut,code)
-C
-            recvfromproc(k) = res
-
-C
-            if (recvfromproc(k)) then
-C
-                Call MPI_RECV(iminmax_temp(:,:,k),
-     &                        2*nbdim,MPI_INTEGER,k,etiquette,
-     &                        MPI_COMM_AGRIF,statut,code)
-
-C                imin_recv(:,k) = iminmax_temp(:,1,k)
-C                imax_recv(:,k) = iminmax_temp(:,2,k)
-
-C                datasize = 1
-C
-C                do i = 1,nbdim
-C
-C                datasize = datasize * (imax_recv(i,k)-imin_recv(i,k)+1)
-C
-C                enddo
-             IF (.Not.Associated(temprecv%var)) allocate(temprecv%var)
-             call Agrif_nbdim_allocation(temprecv%var,
-     &   iminmax_temp(:,1,k),iminmax_temp(:,2,k),nbdim)
-            SELECT CASE(nbdim)
-            CASE(1)
-              datasize=SIZE(temprecv%var%array1)
-              Call MPI_RECV(temprecv%var%array1,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-            CASE(2)
-              datasize=SIZE(temprecv%var%array2)
-              Call MPI_RECV(temprecv%var%array2,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-            CASE(3)
-              datasize=SIZE(temprecv%var%array3)
-              Call MPI_RECV(temprecv%var%array3,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-
-            CASE(4)
-              datasize=SIZE(temprecv%var%array4)
-              Call MPI_RECV(temprecv%var%array4,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-            CASE(5)
-              datasize=SIZE(temprecv%var%array5)
-              Call MPI_RECV(temprecv%var%array5,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-            CASE(6)
-              datasize=SIZE(temprecv%var%array6)
-              Call MPI_RECV(temprecv%var%array6,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-          END SELECT
-            
-            Call where_valtabtotab_mpi(tempCextend%var,
-     &             temprecv%var,iminmax_temp(:,1,k),iminmax_temp(:,2,k)
-     &            ,0.,nbdim)
-     
-                Call Agrif_nbdim_deallocation(temprecv%var,nbdim)
-C                deallocate(temprecv%var)
-            endif
-
-C
-      enddo
-
-          End Subroutine ExchangeSamelevel
-          
-       Subroutine ExchangeSameLevel_first(sendtoproc,nbdim,imin,imax,
-     &          recvfromproc,imin_recv,imax_recv)
-      Implicit None
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin,imax
-      INTEGER,DIMENSION(nbdim,2,0:Agrif_Nbprocs-1) :: iminmax_temp
-      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin_recv,imax_recv
-      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1)       :: sendtoproc
-      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1)       :: recvfromproc
-      LOGICAL                                    :: res
-
-      INCLUDE 'mpif.h'
-          INTEGER :: i,k
-          INTEGER :: etiquette = 100
-          INTEGER :: code, datasize
-          INTEGER,DIMENSION(MPI_STATUS_SIZE)   :: statut
-
-     
-      do k = 0,Agrif_ProcRank-1
-C
-C
-            Call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette,
-     &                    MPI_COMM_AGRIF,code)
-C
-            if (sendtoproc(k)) then
-C
-                iminmax_temp(:,1,k) = imin(:,k)
-                iminmax_temp(:,2,k) = imax(:,k)
-
-                Call MPI_SEND(iminmax_temp(:,:,k),
-     &                        2*nbdim,MPI_INTEGER,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-C
-            endif
-
-C
-      enddo
-C
-C
-C     Reception from others processors of the necessary part of the parent grid
-      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
-C
-C
-            Call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette,
-     &                    MPI_COMM_AGRIF,statut,code)
-C
-            recvfromproc(k) = res
-
-C
-            if (recvfromproc(k)) then
-C
-                Call MPI_RECV(iminmax_temp(:,:,k),
-     &                        2*nbdim,MPI_INTEGER,k,etiquette,
-     &                        MPI_COMM_AGRIF,statut,code)
-
-                imin_recv(:,k) = iminmax_temp(:,1,k)
-                imax_recv(:,k) = iminmax_temp(:,2,k)
-            endif
-
-C
-      enddo
-
-C     Reception from others processors of the necessary part of the parent grid
-      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
-C
-C
-            
-            Call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette,
-     &                    MPI_COMM_AGRIF,code)
-C
-            if (sendtoproc(k)) then
-C
-                iminmax_temp(:,1,k) = imin(:,k)
-                iminmax_temp(:,2,k) = imax(:,k)
-
-                Call MPI_SEND(iminmax_temp(:,:,k),
-     &                        2*nbdim,MPI_INTEGER,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-C
-            endif
-
-C
-      enddo
-C
-C
-C     Reception from others processors of the necessary part of the parent grid
-      do k = Agrif_ProcRank-1,0,-1
-C
-C
-            Call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette,
-     &                    MPI_COMM_AGRIF,statut,code)
-C
-            recvfromproc(k) = res
-
-C
-            if (recvfromproc(k)) then
-C
-                Call MPI_RECV(iminmax_temp(:,:,k),
-     &                        2*nbdim,MPI_INTEGER,k,etiquette,
-     &                        MPI_COMM_AGRIF,statut,code)
-
-                imin_recv(:,k) = iminmax_temp(:,1,k)
-                imax_recv(:,k) = iminmax_temp(:,2,k)
-            endif
-
-C
-      enddo
-
-          End Subroutine ExchangeSamelevel_first          
-
-       Subroutine ExchangeSameLevel2(sendtoproc,recvfromproc,
-     &   nbdim,
-     &          pttruetabwhole,cetruetabwhole,imin,imax,
-     &          imin_recv,imax_recv,memberout,tempC,tempCextend)
-      Implicit None
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin,imax
-      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: pttruetabwhole,
-     &     cetruetabwhole
-      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin_recv,imax_recv
-      TYPE(Agrif_PVARIABLE) :: tempC,tempCextend
-      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1)       :: sendtoproc
-      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1)       :: recvfromproc
-      LOGICAL                                    :: res
-      LOGICAL :: memberout
-      TYPE(AGRIF_PVARIABLE), SAVE                      :: temprecv
-
-      INCLUDE 'mpif.h'
-          INTEGER :: i,k
-          INTEGER :: etiquette = 100
-          INTEGER :: code, datasize
-          INTEGER,DIMENSION(MPI_STATUS_SIZE)   :: statut
-
-      IF (memberout) THEN
-      Call Agrif_nbdim_allocation(tempCextend%var,
-     &                 pttruetabwhole(:,Agrif_ProcRank),
-     &                 cetruetabwhole(:,Agrif_ProcRank),nbdim)
-      call Agrif_nbdim_Full_VarEQreal(tempCextend%var,0.,nbdim)
-      ENDIF
-
-      IF (sendtoproc(Agrif_ProcRank)) THEN
-           Call Agrif_nbdim_VarEQvar(tempCextend%var,
-     &                               imin(:,Agrif_Procrank),
-     &                               imax(:,Agrif_Procrank),
-     &                               tempC%var,
-     &                               imin(:,Agrif_Procrank),
-     &                               imax(:,Agrif_Procrank),
-     &                               nbdim)
-      ENDIF
-
-      do k = 0,Agrif_ProcRank-1
-C
-C
-C
-            if (sendtoproc(k)) then
-C
-                datasize = 1
-C
-!CDIR SHORTLOOP
-                do i = 1,nbdim
-C
-                  datasize = datasize * (imax(i,k)-imin(i,k)+1)
-C
-                enddo
-C
-
-                SELECT CASE(nbdim)
-                CASE(1)
-                   Call MPI_SEND(tempC%var%array1(
-     &                        imin(1,k):imax(1,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(2)               
-                   Call MPI_SEND(tempC%var%array2(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(3)
-     
-                  Call Agrif_Send_3Darray(tempC%var%array3,
-     &             lbound(tempC%var%array3),imin(:,k),imax(:,k),k)
-                CASE(4)
-                   Call MPI_SEND(tempC%var%array4(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(5)
-                   Call MPI_SEND(tempC%var%array5(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k),
-     &                        imin(5,k):imax(5,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(6)
-                   Call MPI_SEND(tempC%var%array6(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k),
-     &                        imin(5,k):imax(5,k),
-     &                        imin(6,k):imax(6,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                END SELECT
-C
-            endif
-
-C
-      enddo
-C
-C
-C     Reception from others processors of the necessary part of the parent grid
-      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
-
-C
-            if (recvfromproc(k)) then
-
-                datasize = 1
-C
-!CDIR SHORTLOOP
-                do i = 1,nbdim
-C
-                datasize = datasize * (imax_recv(i,k)-imin_recv(i,k)+1)
-C
-                enddo
-
-             IF (.Not.Associated(temprecv%var)) allocate(temprecv%var)
-             call Agrif_nbdim_allocation(temprecv%var,imin_recv(:,k),
-     &   imax_recv(:,k),nbdim)
-            SELECT CASE(nbdim)
-            CASE(1)
-              Call MPI_RECV(temprecv%var%array1,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-            CASE(2)           
-              Call MPI_RECV(temprecv%var%array2,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-            CASE(3)       
-              Call MPI_RECV(temprecv%var%array3,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-
-            CASE(4)
-              Call MPI_RECV(temprecv%var%array4,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-            CASE(5)
-              Call MPI_RECV(temprecv%var%array5,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-            CASE(6)
-              Call MPI_RECV(temprecv%var%array6,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-       END SELECT
-                        
-            Call where_valtabtotab_mpi(tempCextend%var,
-     &             temprecv%var,imin_recv(:,k),imax_recv(:,k),0.,nbdim)
-     
-                Call Agrif_nbdim_deallocation(temprecv%var,nbdim)
-C                deallocate(temprecv%var)
-
-            endif
-
-C
-      enddo
-
-C     Reception from others processors of the necessary part of the parent grid
-      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
-C
-C
-            if (sendtoproc(k)) then
-C
-                SELECT CASE(nbdim)
-                CASE(1)
-                datasize=SIZE(tempC%var%array1(
-     &                        imin(1,k):imax(1,k)))
-                   Call MPI_SEND(tempC%var%array1(
-     &                        imin(1,k):imax(1,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(2)                
-                datasize=SIZE(tempC%var%array2(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k)))
-                   Call MPI_SEND(tempC%var%array2(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(3)
-                datasize=SIZE(tempC%var%array3(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k)))
-                   Call MPI_SEND(tempC%var%array3(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(4)
-                datasize=SIZE(tempC%var%array4(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k)))
-                   Call MPI_SEND(tempC%var%array4(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(5)
-                datasize=SIZE(tempC%var%array5(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k),
-     &                        imin(5,k):imax(5,k)))
-                   Call MPI_SEND(tempC%var%array5(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k),
-     &                        imin(5,k):imax(5,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(6)
-                datasize=SIZE(tempC%var%array6(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k),
-     &                        imin(5,k):imax(5,k),
-     &                        imin(6,k):imax(6,k)))
-                   Call MPI_SEND(tempC%var%array6(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k),
-     &                        imin(5,k):imax(5,k),
-     &                        imin(6,k):imax(6,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                END SELECT
-C
-            endif
-
-C
-      enddo
-C
-C
-C     Reception from others processors of the necessary part of the parent grid
-      do k = Agrif_ProcRank-1,0,-1
-C
-
-C
-            if (recvfromproc(k)) then
-C
-             IF (.Not.Associated(temprecv%var)) allocate(temprecv%var)
-             call Agrif_nbdim_allocation(temprecv%var,
-     &   imin_recv(:,k),imax_recv(:,k),nbdim)
-            SELECT CASE(nbdim)
-            CASE(1)
-              datasize=SIZE(temprecv%var%array1)
-              Call MPI_RECV(temprecv%var%array1,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-            CASE(2)           
-              datasize=SIZE(temprecv%var%array2)
-              Call MPI_RECV(temprecv%var%array2,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-            CASE(3)           
-              datasize=SIZE(temprecv%var%array3)
-              Call MPI_RECV(temprecv%var%array3,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-
-            CASE(4)
-              datasize=SIZE(temprecv%var%array4)
-              Call MPI_RECV(temprecv%var%array4,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-            CASE(5)
-              datasize=SIZE(temprecv%var%array5)
-              Call MPI_RECV(temprecv%var%array5,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-            CASE(6)
-              datasize=SIZE(temprecv%var%array6)
-              Call MPI_RECV(temprecv%var%array6,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-          END SELECT
-            
-            Call where_valtabtotab_mpi(tempCextend%var,
-     &             temprecv%var,imin_recv(:,k),imax_recv(:,k)
-     &            ,0.,nbdim)
-     
-                Call Agrif_nbdim_deallocation(temprecv%var,nbdim)
-C                deallocate(temprecv%var)
-            endif
-
-C
-      enddo
-                  
-          End Subroutine ExchangeSamelevel2
-          
-          Subroutine Agrif_Send_3Darray(tab3D,bounds,imin,imax,k)
-          integer, dimension(3) :: bounds, imin, imax
-          real,dimension(bounds(1):,bounds(2):,bounds(3):),target
-     &                             :: tab3D
-          integer :: k
-          integer :: etiquette = 100
-          integer :: datasize, code
-        INCLUDE 'mpif.h'
-
-          datasize = SIZE(tab3D(
-     &                       imin(1):imax(1),
-     &                        imin(2):imax(2),
-     &                        imin(3):imax(3)))
-       
-                   Call MPI_SEND(tab3D(
-     &                        imin(1):imax(1),
-     &                        imin(2):imax(2),
-     &                        imin(3):imax(3)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-     
-         End Subroutine Agrif_Send_3Darray
-
-#else
-      Subroutine Agrif_mpp_empty()
-      End Subroutine Agrif_mpp_empty
-#endif
-
-      End Module Agrif_mpp
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F90	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F90	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modprocs.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modprocs.F90	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modprocs.F90	(revision 6440)
@@ -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: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F	(revision 6439)
+++ 	(revision )
@@ -1,937 +1,0 @@
-!
-! $Id: modsauv.F 2715 2011-03-30 15:58:35Z rblod $
-!
-C     AGRIF (Adaptive Grid Refinement In Fortran)
-C
-C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
-C
-C     This program is free software; you can redistribute it and/or modify
-C     it under the terms of the GNU General Public License as published by
-C     the Free Software Foundation; either version 2 of the License, or
-C     (at your option) any later version.
-C
-C     This program is distributed in the hope that it will be useful,
-C     but WITHOUT ANY WARRANTY; without even the implied warranty of
-C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-C     GNU General Public License for more details.
-C
-C     You should have received a copy of the GNU General Public License
-C     along with this program; if not, write to the Free Software
-C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
-C
-C
-C
-CCC   Module Agrif_Save  
-C
-      Module Agrif_Save 
-C
-CCC   Description:   
-CCC   Module for the initialization by copy of the grids created by clustering.
-C
-C     Modules used:
-C      
-      Use Agrif_Types
-      Use Agrif_Link
-      Use Agrif_Arrays
-      Use Agrif_Variables
-C
-      IMPLICIT NONE
-C
-      Contains
-C     Definition of procedures contained in this module.
-C
-C
-      Subroutine Agrif_Deallocate_Arrays(Var)
-      type(Agrif_Variable), pointer :: Var
-      
-            if (ALLOCATED(var%array1)) then
-               Deallocate(var%array1)
-            endif
-            if (ALLOCATED(var%array2)) then
-               Deallocate(var%array2)
-            endif
-            if (ALLOCATED(var%array3)) then
-               Deallocate(var%array3)
-            endif
-            if (ALLOCATED(var%array4)) then
-               Deallocate(var%array4)
-            endif
-            if (ALLOCATED(var%array5)) then
-               Deallocate(var%array5)
-            endif
-            if (ALLOCATED(var%array6)) then
-               Deallocate(var%array6)
-            endif
-C
-            if (ALLOCATED(var%darray1)) then
-               Deallocate(var%darray1)
-            endif
-            if (ALLOCATED(var%darray2)) then
-               Deallocate(var%darray2)
-            endif
-            if (ALLOCATED(var%darray3)) then
-               Deallocate(var%darray3)
-            endif
-            if (ALLOCATED(var%darray4)) then
-               Deallocate(var%darray4)
-            endif
-            if (ALLOCATED(var%darray5)) then
-               Deallocate(var%darray5)
-            endif
-            if (ALLOCATED(var%darray6)) then
-               Deallocate(var%darray6)
-            endif
-C
-            if (ALLOCATED(var%larray1)) then
-               Deallocate(var%larray1)
-            endif
-            if (ALLOCATED(var%larray2)) then
-               Deallocate(var%larray2)
-            endif
-            if (ALLOCATED(var%larray3)) then
-               Deallocate(var%larray3)
-            endif
-            if (ALLOCATED(var%larray4)) then
-               Deallocate(var%larray4)
-            endif
-            if (ALLOCATED(var%larray5)) then
-               Deallocate(var%larray5)
-            endif
-            if (ALLOCATED(var%larray6)) then
-               Deallocate(var%larray6)
-            endif
-C
-            if (ALLOCATED(var%iarray1)) then
-               Deallocate(var%iarray1)
-            endif
-            if (ALLOCATED(var%iarray2)) then
-               Deallocate(var%iarray2)
-            endif
-            if (ALLOCATED(var%iarray3)) then
-               Deallocate(var%iarray3)
-            endif
-            if (ALLOCATED(var%iarray4)) then
-               Deallocate(var%iarray4)
-            endif
-            if (ALLOCATED(var%iarray5)) then
-               Deallocate(var%iarray5)
-            endif
-            if (ALLOCATED(var%iarray6)) then
-               Deallocate(var%iarray6)
-            endif
-C
-            if (ALLOCATED(var%carray1)) then
-               Deallocate(var%carray1)
-            endif
-            if (ALLOCATED(var%carray2)) then
-               Deallocate(var%carray2)
-            endif
-C
-            if (associated(var%oldvalues2D)) then
-               Deallocate(var%oldvalues2D)
-            endif
-            if (associated(var%interpIndex)) then
-               Deallocate(var%interpIndex)
-            endif
-            
-            if (associated(var%posvar)) then
-               Deallocate(var%posvar)
-            endif     
-            
-            if (associated(var%interptab)) then
-               Deallocate(var%interptab)
-            endif
-            
-      Return
-      End Subroutine Agrif_Deallocate_Arrays    
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Free_data_before
-C     **************************************************************************
-C
-      Subroutine Agrif_Free_data_before(Agrif_Gr)
-C
-CCC   Description:
-CCC   
-C
-CC    Method:
-CC            
-C
-C     Declarations:
-C
-      
-C      
-C     Pointer argument    
-      TYPE(Agrif_Grid),pointer   :: Agrif_Gr ! Pointer on the current grid
-      INTEGER i 
-      Type(Agrif_List_Variables), pointer :: parcours      
-C
-C   
-      do i = 1 , AGRIF_NbVariables
-         if ( .NOT. Agrif_Mygrid % tabvars(i) % var % restaure) then
-C 
-            call Agrif_Deallocate_Arrays(Agrif_Gr%tabvars(i)%var)
-            
-       endif
-           
-C
-       if (associated(Agrif_Gr%tabvars(i)%var%list_interp)) then
-         Call Agrif_Free_list_interp
-     &                          (Agrif_Gr%tabvars(i)%var%list_interp)
-       endif                             
-C
-       if ( .NOT. Agrif_Mygrid % tabvars(i) % var % restaure) then
-            Deallocate(Agrif_Gr%tabvars(i)%var)
-C 
-        endif
-      enddo
-      
-      parcours => Agrif_Gr%variables
-    
-      do i=1,Agrif_Gr%NbVariables
-       if (.NOT. parcours%pvar%var%root_var%restaure) then
-        call Agrif_Deallocate_Arrays(parcours%pvar%var)
-       endif
-        if (associated(parcours%pvar%var%list_interp)) then
-           Call Agrif_Free_list_interp
-     &                          (parcours%pvar%var%list_interp)
-         endif                             
-C
-       if ( .NOT. parcours%pvar%var%root_var % restaure) then
-            Deallocate(parcours%pvar%var)
-C 
-        endif
-        parcours => parcours%nextvariable
-      enddo
-C
-C 
-C
-      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
-         if ( Agrif_Probdim .EQ. 1 ) Deallocate(Agrif_Gr%tabpoint1D)
-         if ( Agrif_Probdim .EQ. 2 ) Deallocate(Agrif_Gr%tabpoint2D)
-         if ( Agrif_Probdim .EQ. 3 ) Deallocate(Agrif_Gr%tabpoint3D)
-      endif
-C          
-      Return
-C
-C
-      End Subroutine Agrif_Free_data_before
-C
-C
-      Recursive Subroutine Agrif_Free_list_interp(list_interp)
-      TYPE(Agrif_List_Interp_Loc), Pointer :: list_interp
-      
-      if (associated(list_interp%suiv))
-     &      Call Agrif_Free_list_interp(list_interp%suiv)
-     
-#ifdef key_mpp_mpi
-       Deallocate(list_interp%interp_loc%tab4t)
-       Deallocate(list_interp%interp_loc%memberinall)
-       Deallocate(list_interp%interp_loc%sendtoproc1)
-       Deallocate(list_interp%interp_loc%recvfromproc1)
-#endif
-       Deallocate(list_interp%interp_loc)
-       Deallocate(list_interp)
-       Nullify(list_interp)
-
-      End Subroutine Agrif_Free_list_interp      
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Free_data_after
-C     **************************************************************************
-C      
-      Subroutine Agrif_Free_data_after(Agrif_Gr)
-C
-CCC   Description:
-CCC   
-C
-CC    Method:
-CC            
-C
-C     Declarations:
-C
-C
-      
-C
-C     Pointer argument    
-      TYPE(Agrif_Grid),pointer   :: Agrif_Gr  ! Pointer on the current grid
-      INTEGER i
-      Type(Agrif_List_Variables), pointer :: parcours, rootparcours
-C
-C      
-      do i = 1 , AGRIF_NbVariables
-         if ( Agrif_Mygrid % tabvars(i) % var % restaure) then
-            
-         call Agrif_Deallocate_Arrays(Agrif_Gr%tabvars(i)%var)
-         !
-            Deallocate(Agrif_Gr%tabvars(i)%var)
-! 
-         endif
-      enddo
-      
-      parcours => Agrif_Gr%variables
-      rootparcours=>Agrif_Mygrid%variables
-    
-      do i=1,Agrif_Gr%NbVariables
-       if (rootparcours%pvar%var%restaure) then
-        call Agrif_Deallocate_Arrays(parcours%pvar%var)
-      
-            Deallocate(parcours%pvar%var)
-C 
-        endif
-        parcours => parcours%nextvariable
-        rootparcours => rootparcours%nextvariable        
-      enddo
-            
-C
-C      
-      Return
-C
-C
-      End Subroutine Agrif_Free_data_after      
-C
-C
-CC    **************************************************************************
-CCC   Subroutine AGRIF_CopyFromold_All
-C     **************************************************************************
-C
-      Recursive Subroutine AGRIF_CopyFromold_All(g,oldchildgrids)
-C
-CCC   Description:
-CCC   Routine called in the Agrif_Init_Hierarchy procedure 
-C       (Agrif_Clustering module). 
-C
-CC    Method:        
-C
-C     Declarations:
-C
-      
-C      
-C     Pointer argument    
-      TYPE(AGRIF_grid),pointer   :: g ! Pointer on the current grid
-      TYPE(AGRIF_pgrid),pointer   :: oldchildgrids
-C
-C     Local pointer
-      TYPE(AGRIF_pgrid),pointer  :: parcours ! Pointer for the recursive 
-                                             ! procedure 
-      REAL g_eps,eps,oldgrid_eps
-      INTEGER :: out
-      INTEGER :: iii
-C
-      out = 0
-C                                                                           
-      parcours => oldchildgrids  
-C
-      do while (associated(parcours))
-C 
-        if ((.NOT. g % fixed) .AND. (parcours % gr %oldgrid)) then
-C        
-            g_eps = huge(1.)
-            oldgrid_eps = huge(1.)
-            do iii = 1 , Agrif_Probdim
-               g_eps = min(g_eps,g % Agrif_d(iii))
-               oldgrid_eps = min(oldgrid_eps,
-     &                       parcours % gr % Agrif_d(iii))
-            enddo
-C
-            eps = min(g_eps,oldgrid_eps)/100.                  
-C
-            do iii = 1 , Agrif_Probdim
-
-               if (g % Agrif_d(iii) .LT. 
-     &             (parcours % gr % Agrif_d(iii) - eps)) then
-C            
-                   parcours => parcours % next
-C            
-                   out = 1
-C   
-                   Exit
-C             
-               endif
-C      
-            enddo
-        if ( out .EQ. 1 ) Cycle
-C
-            Call AGRIF_CopyFromOld(g,parcours%gr)
-C
-        endif
-C                     
-        Call Agrif_CopyFromold_All
-     &             (g, parcours % gr % child_grids)
-C        
-        parcours => parcours % next
-C        
-      enddo
-C
-C     
-      Return      
-C
-C
-      End Subroutine AGRIF_CopyFromold_All
-C
-C
-C      
-C     **************************************************************************
-CCC   Subroutine Agrif_CopyFromold
-C     **************************************************************************
-C      
-      Subroutine Agrif_CopyFromold(Agrif_New_Gr,Agrif_Old_Gr)
-C
-CCC   Description:
-CCC   Call to the Agrif_Copy procedure.
-C
-CC    Method:
-CC            
-C
-C     Declarations:
-C
-      
-C      
-C     Pointer argument    
-      TYPE(Agrif_Grid),Pointer   :: Agrif_New_Gr  ! Pointer on the current grid
-      TYPE(Agrif_Grid),Pointer :: Agrif_Old_Gr    ! Pointer on an old grid
-      INTEGER :: i
-C
-C      
-      do i = 1 , AGRIF_NbVariables
-         if ( Agrif_Mygrid % tabvars(i) % var % restaure ) then
-C
-            Call Agrif_Copy(Agrif_New_Gr,Agrif_Old_Gr,
-     &           Agrif_New_Gr % tabvars(i),
-     &           Agrif_Old_Gr % tabvars(i))
-C
-        endif
-      enddo
-
-C      
-C            
-      Return
-C
-C      
-      End Subroutine Agrif_CopyFromold
-      
-CC    **************************************************************************
-CCC   Subroutine AGRIF_CopyFromold_AllOneVar
-C     **************************************************************************
-C
-      Recursive Subroutine AGRIF_CopyFromold_AllOneVar(g,oldchildgrids,
-     &   indic)
-C
-CCC   Description:
-CCC   Routine called in the Agrif_Init_Hierarchy procedure 
-C       (Agrif_Clustering module). 
-C
-CC    Method:        
-C
-C     Declarations:
-C
-      
-C      
-C     Pointer argument    
-      TYPE(AGRIF_grid),pointer   :: g ! Pointer on the current grid
-      TYPE(AGRIF_pgrid),pointer   :: oldchildgrids
-      integer :: indic
-C
-C     Local pointer
-      TYPE(AGRIF_pgrid),pointer  :: parcours ! Pointer for the recursive 
-                                             ! procedure 
-      REAL g_eps,eps,oldgrid_eps
-      INTEGER :: out
-      INTEGER :: iii
-C
-      out = 0
-C                                                                           
-      parcours => oldchildgrids  
-C
-      do while (associated(parcours))
-C 
-        if ((.NOT. g % fixed) .AND. (parcours % gr %oldgrid)) then
-C        
-            g_eps = huge(1.)
-            oldgrid_eps = huge(1.)
-            do iii = 1 , Agrif_Probdim
-               g_eps = min(g_eps,g % Agrif_d(iii))
-               oldgrid_eps = min(oldgrid_eps,
-     &                       parcours % gr % Agrif_d(iii))
-            enddo
-C
-            eps = min(g_eps,oldgrid_eps)/100.                  
-C
-            do iii = 1 , Agrif_Probdim
-
-               if (g % Agrif_d(iii) .LT. 
-     &             (parcours % gr % Agrif_d(iii) - eps)) then
-C            
-                   parcours => parcours % next
-C            
-                   out = 1
-C   
-                   Exit
-C             
-               endif
-C      
-            enddo
-        if ( out .EQ. 1 ) Cycle
-C
-            Call AGRIF_CopyFromOldOneVar(g,parcours%gr,indic)
-C
-        endif
-C                     
-        Call Agrif_CopyFromold_AllOneVar
-     &             (g, parcours % gr % child_grids,indic)
-C        
-        parcours => parcours % next
-C        
-      enddo
-C
-C     
-      Return      
-C
-C
-      End Subroutine AGRIF_CopyFromold_AllOneVar
-C
-C
-C      
-C     **************************************************************************
-CCC   Subroutine Agrif_CopyFromoldOneVar
-C     **************************************************************************
-C      
-      Subroutine Agrif_CopyFromoldOneVar(Agrif_New_Gr,Agrif_Old_Gr,
-     &    indic)
-C
-CCC   Description:
-CCC   Call to the Agrif_Copy procedure.
-C
-CC    Method:
-CC            
-C
-C     Declarations:
-C
-      
-C      
-C     Pointer argument    
-      TYPE(Agrif_Grid),Pointer   :: Agrif_New_Gr  ! Pointer on the current grid
-      TYPE(Agrif_Grid),Pointer :: Agrif_Old_Gr    ! Pointer on an old grid
-      INTEGER :: indic
-      INTEGER :: i
-      TYPE(Agrif_PVariable),Pointer ::tabvars,oldtabvars      
-C
-C      
-      tabvars => Agrif_Search_Variable(Agrif_New_Gr,-indic)
-      oldtabvars => Agrif_Search_Variable(Agrif_Old_Gr,-indic)
-
-      Call Agrif_Nbdim_Allocation(tabvars%var,
-     &  tabvars%var%lb,tabvars%var%ub,
-     &  tabvars%var%nbdim)
-     
-      Call Agrif_Copy(Agrif_New_Gr,Agrif_Old_Gr,
-     &           tabvars,oldtabvars)
-
-
-C      
-C            
-      Return
-C
-C      
-      End Subroutine Agrif_CopyFromoldOneVar      
-      
-C
-C
-CC
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Copy
-C     **************************************************************************
-C      
-      Subroutine Agrif_Copy(Agrif_New_Gr,Agrif_Old_Gr,New_Var,Old_Var)
-C     
-CCC   Description:
-CCC   Sets arguments of the Agrif_UpdatenD procedures, n being the number of 
-CCC   DIMENSION of the grid variable.
-C
-CC    Method:
-CC            
-C
-C     Declarations:
-C
-      
-C
-C     Pointer argument    
-      TYPE(Agrif_Grid),Pointer   :: Agrif_New_Gr   ! Pointer on the current grid
-      TYPE(Agrif_Grid), Pointer :: Agrif_Old_Gr    ! Pointer on an old grid
-      TYPE(Agrif_Pvariable) :: New_Var, Old_Var
-      INTEGER :: nbdim                  ! Number of dimensions of the current 
-                                        ! grid      
-      INTEGER,DIMENSION(6) :: pttabnew  ! Indexes of the first point in the 
-                                        ! domain
-      INTEGER,DIMENSION(6) :: petabnew  ! Indexes of the first point in the 
-                                        ! domain
-      INTEGER,DIMENSION(6) :: pttabold  ! Indexes of the first point in the 
-                                        ! domain
-      INTEGER,DIMENSION(6) :: petabold  ! Indexes of the first point in the 
-                                        ! domain
-      INTEGER,DIMENSION(6) :: nbtabold  ! Number of cells in each direction
-      
-      INTEGER,DIMENSION(6) :: nbtabnew  ! Number of cells in each direction   
-      TYPE(AGRIF_Variable), Pointer :: root ! Pointer on the variable of the 
-                                            ! root grid
-      REAL, DIMENSION(6) :: snew,sold
-      REAL, DIMENSION(6) :: dsnew,dsold                              
-      REAL :: eps
-      INTEGER :: n
-C
-C  
-      root => New_Var % var % root_var 
-C      
-      nbdim = root % nbdim
-C         
-      do n=1,nbdim
-C  
-        select case(root % interptab(n))
-C        
-        case('x')                
-C
-          pttabnew(n) = root % point(1)
-C        
-          pttabold(n) = root % point(1)
-C        
-          snew(n) = Agrif_New_Gr % Agrif_x(1)
-C
-          sold(n) = Agrif_Old_Gr % Agrif_x(1) 
-C        
-          dsnew(n) = Agrif_New_Gr % Agrif_d(1)
-C
-          dsold(n) = Agrif_Old_Gr % Agrif_d(1)
-C                      
-          if (root % posvar(n) .EQ. 1) then
-C          
-              petabnew(n) = pttabnew(n) + Agrif_New_Gr % nb(1)
-C          
-              petabold(n) = pttabold(n) + Agrif_Old_Gr % nb(1)         
-C        
-            else
-C          
-              petabnew(n) = pttabnew(n) + Agrif_New_Gr % nb(1) - 1
-C          
-              petabold(n) = pttabold(n) + Agrif_Old_Gr % nb(1) - 1
-C
-              snew(n) = snew(n) + dsnew(n)/2.
-C
-              sold(n) = sold(n) + dsold(n)/2.
-C        
-          endif           
-C        
-        case('y')
-C        
-          pttabnew(n) = root % point(2)
-C        
-          pttabold(n) = root % point(2)
-C        
-          snew(n) = Agrif_New_Gr % Agrif_x(2)
-C        
-          sold(n) = Agrif_Old_Gr % Agrif_x(2)
-C        
-          dsnew(n) = Agrif_New_Gr % Agrif_d(2)
-C        
-          dsold(n) = Agrif_Old_Gr % Agrif_d(2)
-C                
-          if (root % posvar(n) .EQ. 1) then
-C        
-              petabnew(n) = pttabnew(n) + Agrif_New_Gr % nb(2)
-C          
-              petabold(n) = pttabold(n) + Agrif_Old_Gr % nb(2)         
-C        
-            else
-C          
-              petabnew(n) = pttabnew(n) + Agrif_New_Gr % nb(2) - 1
-C          
-              petabold(n) = pttabold(n) + Agrif_Old_Gr % nb(2) - 1
-C
-              snew(n) = snew(n) + dsnew(n)/2.
-C
-              sold(n) = sold(n) + dsold(n)/2.                    
-C        
-          endif 
-C        
-        case('z')
-C        
-          pttabnew(n) = root % point(3)
-C        
-          pttabold(n) = root % point(3)
-C        
-          snew(n) = Agrif_New_Gr % Agrif_x(3)
-C        
-          sold(n) = Agrif_Old_Gr % Agrif_x(3)
-C        
-          dsnew(n) = Agrif_New_Gr % Agrif_d(3)
-C        
-          dsold(n) = Agrif_Old_Gr % Agrif_d(3)
-C                
-          if (root % posvar(n) .EQ. 1) then
-C        
-              petabnew(n) = pttabnew(n) + Agrif_New_Gr % nb(3)
-C          
-              petabold(n) = pttabold(n) + Agrif_Old_Gr % nb(3)         
-C        
-            else
-C          
-             petabnew(n) = pttabnew(n) + Agrif_New_Gr % nb(3) - 1
-C          
-             petabold(n) = pttabold(n) + Agrif_Old_Gr % nb(3) - 1
-C
-             snew(n) = snew(n) + dsnew(n)/2.
-C
-             sold(n) = sold(n) + dsold(n)/2.                   
-C        
-          endif
-C          
-        case('N')
-C        
-          Call Agrif_nbdim_Get_bound(New_Var%var,
-     &                           pttabnew(n),petabnew(n),
-     &                           n,nbdim)
-C        
-          pttabold(n) = pttabnew(n)
-C      
-          petabold(n) = petabnew(n)
-C              
-          snew(n) = 0.
-C      
-          sold(n) = 0. 
-C      
-          dsnew(n) = 1.
-C      
-          dsold(n) = 1.
-C        
-        end select
-C      
-      enddo
-C      
-      do n = 1,nbdim
-C      
-        nbtabnew(n) = petabnew(n) - pttabnew(n)
-C      
-        nbtabold(n) = petabold(n) - pttabold(n)      
-C 
-      enddo      
-C
-      eps = min(minval(dsnew(1:nbdim)),minval(dsold(1:nbdim)))
-C     
-      eps = eps/100.      
-C      
-      do n = 1,nbdim
-C      
-        if (snew(n) .GT. (sold(n)+dsold(n)*nbtabold(n)+eps)) Return
-C      
-        if ((snew(n)+dsnew(n)*nbtabnew(n)-eps) .LT. sold(n)) Return
-C      
-      enddo
-C            
-C
-      Call AGRIF_CopynD
-     &        (New_Var,Old_Var,pttabold,petabold,pttabnew,petabnew,
-     &         sold,snew,dsold,dsnew,nbdim) 
-C      
-C 
-      Return
-C      
-C
-      End Subroutine Agrif_Copy
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_CopynD
-C     **************************************************************************
-C      
-      Subroutine Agrif_CopynD(New_Var,Old_Var,pttabold,petabold,
-     &                        pttabnew,petabnew,sold,snew,dsold,
-     &                        dsnew,nbdim)
-C     
-CCC   Description:
-CCC   Copy of the nD New_Var variable from the nD Old_Var variable.
-C
-CC    Method:
-CC            
-C
-C     Declarations:
-C
-      
-C
-      INTEGER :: nbdim
-      TYPE(Agrif_Pvariable) :: New_Var, Old_Var     
-      INTEGER,DIMENSION(nbdim) :: pttabnew 
-      INTEGER,DIMENSION(nbdim) :: petabnew
-      INTEGER,DIMENSION(nbdim) :: pttabold
-      INTEGER,DIMENSION(nbdim) :: petabold      
-      REAL, DIMENSION(nbdim) :: snew,sold
-      REAL, DIMENSION(nbdim) :: dsnew,dsold 
-C
-      INTEGER :: i,j,k,l,m,n,i0,j0,k0,l0,m0,n0
-C
-      REAL, DIMENSION(nbdim) :: dim_gmin,dim_gmax
-      REAL, DIMENSION(nbdim) :: dim_newmin,dim_newmax
-      REAL, DIMENSION(nbdim) :: dim_min
-      INTEGER, DIMENSION(nbdim) :: ind_gmin,ind_newmin
-      INTEGER, DIMENSION(nbdim) ::  ind_newmax
-C               
-C
-      do i = 1,nbdim
-C      
-        dim_gmin(i) = sold(i)
-        dim_gmax(i) = sold(i) + (petabold(i)-pttabold(i)) * dsold(i)
-C 
-        dim_newmin(i) = snew(i)
-        dim_newmax(i) = snew(i) + (petabnew(i)-pttabnew(i)) * dsnew(i)
-C
-      enddo         
-C
-      do i = 1,nbdim
-C  
-        if (dim_gmax(i) .LT. dim_newmin(i)) Return
-C      
-        if (dim_gmin(i) .GT. dim_newmax(i)) Return
-C
-      enddo
-C
-C
-      do i = 1,nbdim
-C 
-        ind_newmin(i) = pttabnew(i) - floor(-(max(dim_gmin(i),
-     &                      dim_newmin(i))-dim_newmin(i))/dsnew(i)) 
-C      
-        dim_min(i) = snew(i) + (ind_newmin(i)-pttabnew(i))*dsnew(i)
-C      
-        ind_gmin(i) = pttabold(i) + nint((dim_min(i)-
-     &                dim_gmin(i))/dsold(i))      
-C
-        ind_newmax(i) = pttabnew(i) 
-     &                  + int((min(dim_gmax(i),dim_newmax(i))
-     &                         -dim_newmin(i))/dsnew(i))
-C
-      enddo 
-C
-C
-C
-      SELECT CASE (nbdim)
-      CASE (1)
-         i0 = ind_gmin(1)
-         do i = ind_newmin(1),ind_newmax(1)
-            New_Var % var % array1(i) =
-     &      Old_Var % var % array1(i0)
-            New_Var % var % restore1D(i) = 1   
-         i0 = i0 + int(dsnew(1)/dsold(1))
-         enddo
-      CASE (2)
-
-        i0 = ind_gmin(1)
-        do i = ind_newmin(1),ind_newmax(1)
-        j0 = ind_gmin(2)
-        do j = ind_newmin(2),ind_newmax(2)
-           New_Var % var % array2(i,j) =
-     &            Old_Var % var % array2(i0,j0)
-           New_Var % var % restore2D(i,j) = 1
-               j0 = j0 + int(dsnew(2)/dsold(2))
-        enddo
-        i0 = i0 + int(dsnew(1)/dsold(1))
-        enddo
-      CASE (3)
-        i0 = ind_gmin(1)
-        do i = ind_newmin(1),ind_newmax(1)
-        j0 = ind_gmin(2)
-        do j = ind_newmin(2),ind_newmax(2)
-        k0 = ind_gmin(3)
-        do k = ind_newmin(3),ind_newmax(3)
-           New_Var % var % array3(i,j,k) =
-     &                  Old_Var % var % array3(i0,j0,k0)
-           New_Var % var % restore3D(i,j,k) = 1   
-                     k0 = k0 + int(dsnew(3)/dsold(3))
-        enddo
-        j0 = j0 + int(dsnew(2)/dsold(2))
-        enddo
-        i0 = i0 + int(dsnew(1)/dsold(1))
-        enddo
-      CASE (4)
-        i0 = ind_gmin(1)
-        do i = ind_newmin(1),ind_newmax(1)
-        j0 = ind_gmin(2)
-        do j = ind_newmin(2),ind_newmax(2)
-        k0 = ind_gmin(3)
-        do k = ind_newmin(3),ind_newmax(3)
-        l0 = ind_gmin(4)
-        do l = ind_newmin(4),ind_newmax(4) 
-           New_Var % var % array4(i,j,k,l) =
-     &                        Old_Var % var % array4(i0,j0,k0,l0)
-           New_Var % var % restore4D(i,j,k,l) = 1   
-        l0 = l0 + int(dsnew(4)/dsold(4))
-        enddo
-        k0 = k0 + int(dsnew(3)/dsold(3))
-        enddo
-        j0 = j0 + int(dsnew(2)/dsold(2))
-        enddo
-        i0 = i0 + int(dsnew(1)/dsold(1))
-        enddo
-      CASE (5)
-        i0 = ind_gmin(1)
-        do i = ind_newmin(1),ind_newmax(1)
-        j0 = ind_gmin(2)
-        do j = ind_newmin(2),ind_newmax(2)
-        k0 = ind_gmin(3)
-        do k = ind_newmin(3),ind_newmax(3)
-        l0 = ind_gmin(4)
-        do l = ind_newmin(4),ind_newmax(4) 
-        m0 = ind_gmin(5)
-        do m = ind_newmin(5),ind_newmax(5)
-           New_Var % var % array5(i,j,k,l,m) =
-     &                        Old_Var % var % array5(i0,j0,k0,l0,m0)
-           New_Var % var % restore5D(i,j,k,l,m) = 1
-        m0 = m0 + int(dsnew(5)/dsold(5)) 
-        enddo
-        l0 = l0 + int(dsnew(4)/dsold(4))
-        enddo
-        k0 = k0 + int(dsnew(3)/dsold(3))
-        enddo
-        j0 = j0 + int(dsnew(2)/dsold(2))
-        enddo
-        i0 = i0 + int(dsnew(1)/dsold(1))
-        enddo
-      CASE (6)
-        i0 = ind_gmin(1)
-        do i = ind_newmin(1),ind_newmax(1)
-        j0 = ind_gmin(2)
-        do j = ind_newmin(2),ind_newmax(2)
-        k0 = ind_gmin(3)
-        do k = ind_newmin(3),ind_newmax(3)
-        l0 = ind_gmin(4)
-        do l = ind_newmin(4),ind_newmax(4) 
-        m0 = ind_gmin(5)
-        do m = ind_newmin(5),ind_newmax(5)
-        n0 = ind_gmin(6)
-        do n = ind_newmin(6),ind_newmax(6)
-           New_Var % var % array6(i,j,k,l,m,n) =
-     &                        Old_Var % var % array6(i0,j0,k0,l0,m0,n0)
-           New_Var % var % restore6D(i,j,k,l,m,n) = 1
-        n0 = n0 + int(dsnew(6)/dsold(6)) 
-        enddo
-        m0 = m0 + int(dsnew(5)/dsold(5)) 
-        enddo
-        l0 = l0 + int(dsnew(4)/dsold(4))
-        enddo
-        k0 = k0 + int(dsnew(3)/dsold(3))
-        enddo
-        j0 = j0 + int(dsnew(2)/dsold(2))
-        enddo
-        i0 = i0 + int(dsnew(1)/dsold(1))
-        enddo
-      END SELECT
-C           
-      Return
-C
-C
-      End Subroutine Agrif_CopynD                    
-C
-C
-C
-      End module Agrif_Save
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F90	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F90	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modseq.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modseq.F90	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modseq.F90	(revision 6440)
@@ -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: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F	(revision 6439)
+++ 	(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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F90	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F90	(revision 6440)
@@ -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: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F	(revision 6439)
+++ 	(revision )
@@ -1,2677 +1,0 @@
-!
-! $Id: modupdate.F 2731 2011-04-08 12:05:35Z rblod $
-!
-C     AGRIF (Adaptive Grid Refinement In Fortran)
-C
-C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
-C
-C     This program is free software; you can redistribute it and/or modify
-C     it under the terms of the GNU General Public License as published by
-C     the Free Software Foundation; either version 2 of the License, or
-C     (at your option) any later version.
-C
-C     This program is distributed in the hope that it will be useful,
-C     but WITHOUT ANY WARRANTY; without even the implied warranty of
-C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-C     GNU General Public License for more details.
-C
-C     You should have received a copy of the GNU General Public License
-C     along with this program; if not, write to the Free Software
-C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
-C
-C
-C
-CCC   Module Agrif_Update
-C
-      Module Agrif_Update
-C
-CCC   Description:
-CCC   Module to update a parent grid from its child grids
-C
-C     Modules used:
-C   
-      Use Agrif_Updatebasic
-c      Use Agrif_Boundary
-      Use Agrif_Arrays
-      Use Agrif_CurgridFunctions
-      Use Agrif_Mask
-#ifdef key_mpp_mpi
-      Use Agrif_mpp
-#endif
-C
-      IMPLICIT NONE
-      logical, private :: precomputedone(7) = .FALSE.      
-C      
-      CONTAINS
-C     Define procedures contained in this module
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Update_1d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Update_1d(TypeUpdate,parent,child,tab,deb,fin,
-     &                           procname)
-C
-CCC   Description:
-CCC   Subroutine to update a 1D grid variable on the parent grid.
-C
-C     Declarations:
-C
-      
-C
-C     Arguments      
-      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
-      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
-      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations 
-                                              ! are done on the fine grid       
-      External :: procname
-      Optional ::  procname      
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1)
-     &         ), Target :: tab    ! Result
-C
-C
-C     Definition of a temporary AGRIF_PVariable data TYPE  
-      allocate(childtemp % var)
-C
-C     Pointer on the root variable
-      childtemp % var % root_var => child % var %root_var
-C      
-C     Number of dimensions of the grid variable
-      childtemp % var % nbdim = 1  
-C      
-C     Values on the current grid used for the update
-C      childtemp % var % array1 => tab
-      
-      childtemp % var % lb = child % var % lb
-      childtemp % var % ub = child % var % ub             
-      
-C      childtemp % var % list_update => child%var%list_update
-             
-C
-     
-      IF (present(procname)) THEN
-      CALL Agrif_UpdateVariable
-     &     (TypeUpdate,parent,child,deb,fin,procname)
-      ELSE
-      CALL Agrif_UpdateVariable
-     &     (TypeUpdate,parent,child,deb,fin)
-      ENDIF     
-C      
-C      child % var % list_update => childtemp%var%list_update
-      
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Update_1D
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Update_2d
-C     **************************************************************************
-C 
-
-      Subroutine Agrif_Update_2d(TypeUpdate,parent,child,tab,deb,fin,
-     &                           procname)
-C
-CCC   Description:
-CCC   Subroutine to update a 2D grid variable on the parent grid.
-C
-C     Declarations:
-C
-      
-C
-C     Arguments      
-      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
-      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
-      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations  
-                                              ! are done on the fine grid 
-                                              
-      External :: procname
-      Optional ::  procname
-                                                          
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1),
-     &         child%var%lb(2):child%var%ub(2)
-     &    ), Target :: tab    ! Result
-C
-C
-C     Definition of a temporary AGRIF_PVariable data TYPE
-      allocate(childtemp % var)
-C
-C     Pointer on the root variable
-      childtemp % var % root_var => child % var %root_var
-C      
-C     Number of dimensions of the grid variable
-      childtemp % var % nbdim = 2  
-C      
-C     Values on the current grid used for the update
-C      childtemp % var % array2 => tab 
-      
-      childtemp % var % lb = child % var % lb
-      childtemp % var % ub = child % var % ub             
-      
-C      childtemp % var % list_update => child%var%list_update      
-C
-      IF (present(procname)) THEN
-      CALL Agrif_UpdateVariable
-     &     (TypeUpdate,parent,child,deb,fin,procname)
-      ELSE
-      CALL Agrif_UpdateVariable
-     &     (TypeUpdate,parent,child,deb,fin)
-      ENDIF
-C      
-C      child % var % list_update => childtemp%var%list_update
-      
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Update_2D
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Update_3d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Update_3d(TypeUpdate,parent,child,tab,deb,fin,
-     &                           procname)
-C
-CCC   Description:
-CCC   Subroutine to update a 3D grid variable on the parent grid.
-C
-C     Declarations:
-C
-      
-C
-C     Arguments      
-      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
-      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
-      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations 
-                                              ! are done on the fine grid    
-      External :: procname
-      Optional ::  procname
-                                                       
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1),
-     &         child%var%lb(2):child%var%ub(2),
-     &         child%var%lb(3):child%var%ub(3)
-     &      ), Target :: tab  ! Results  
-C
-C
-C     Definition of a temporary AGRIF_PVariable data TYPE  
-      allocate(childtemp % var)
-C
-C     Pointer on the root variable
-      childtemp % var % root_var => child % var %root_var
-C      
-C     Number of dimensions of the grid variable
-      childtemp % var % nbdim = 3  
-C      
-C     Values on the current grid used for the update
-C      childtemp % var % array3 => tab     
-      
-      childtemp % var % lb = child % var % lb
-      childtemp % var % ub = child % var % ub  
-            
-      
-C      childtemp % var % list_update => child%var%list_update      
-C
-      IF (present(procname)) THEN
-      CALL Agrif_UpdateVariable
-     &     (TypeUpdate,parent,child,deb,fin,procname)
-      ELSE
-      CALL Agrif_UpdateVariable
-     &     (TypeUpdate,parent,child,deb,fin)
-      ENDIF
-C      
-C      child % var % list_update => childtemp%var%list_update
-      
-      DEALLOCATE(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Update_3D
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Update_4d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Update_4d(TypeUpdate,parent,child,tab,deb,fin,
-     &                           procname)
-C
-CCC   Description:
-CCC   Subroutine to update a 4D grid variable on the parent grid.
-C
-C     Declarations:
-C
-      
-C
-C     Arguments      
-      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
-      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
-      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations 
-                                              ! are done on the fine grid     
-      External :: procname
-      Optional ::  procname        
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1),
-     &         child%var%lb(2):child%var%ub(2),
-     &         child%var%lb(3):child%var%ub(3),
-     &         child%var%lb(4):child%var%ub(4)
-     &      ), Target :: tab  ! Results
-C
-C
-C     Definition of a temporary AGRIF_PVariable data TYPE  
-      allocate(childtemp % var)
-C
-C     Pointer on the root variable
-      childtemp % var % root_var => child % var %root_var
-C      
-C     Number of dimensions of the grid variable
-      childtemp % var % nbdim = 4  
-C      
-C     Values on the current grid used for the update
-C      childtemp % var % array4 => tab     
-      
-      childtemp % var % lb = child % var % lb
-      childtemp % var % ub = child % var % ub  
-            
-      
-C      childtemp % var % list_update => child%var%list_update
-            
-C
-      IF (present(procname)) THEN
-      CALL Agrif_UpdateVariable
-     &     (TypeUpdate,parent,child,deb,fin,procname)
-      ELSE
-      CALL Agrif_UpdateVariable
-     &     (TypeUpdate,parent,child,deb,fin)
-      ENDIF
-
-C      child % var % list_update => childtemp%var%list_update      
-C
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Update_4D
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Update_5d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Update_5d(TypeUpdate,parent,child,tab,deb,fin,
-     &                           procname)
-C
-CCC   Description:
-CCC   Subroutine to update a 5D grid variable on the parent grid.
-C
-C     Declarations:
-C
-      
-C
-C     Arguments      
-      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
-      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
-      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations 
-                                              ! are done on the fine grid     
-      External :: procname
-      Optional ::  procname
-              
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1),
-     &         child%var%lb(2):child%var%ub(2),
-     &         child%var%lb(3):child%var%ub(3),
-     &         child%var%lb(4):child%var%ub(4),
-     &         child%var%lb(5):child%var%ub(5)
-     &      ),  Target :: tab  ! Results
-C
-C
-C     Definition of a temporary AGRIF_PVariable data TYPE  
-      allocate(childtemp % var)
-C
-C     Pointer on the root variable
-      childtemp % var % root_var => child % var %root_var
-C
-C     Number of dimensions of the grid variable
-      childtemp % var % nbdim = 5  
-C      
-C     Values on the current grid used for the update
-C      childtemp % var % array5 => tab      
-      
-      childtemp % var % lb = child % var % lb
-      childtemp % var % ub = child % var % ub        
-      
-C      childtemp % var % list_update => child%var%list_update      
-C
-      IF (present(procname)) THEN
-      CALL Agrif_UpdateVariable
-     &     (TypeUpdate,parent,child,deb,fin,procname)
-      ELSE
-      CALL Agrif_UpdateVariable
-     &     (TypeUpdate,parent,child,deb,fin)
-      ENDIF
-      
-C      child % var % list_update => childtemp%var%list_update
-            
-C      
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Update_5D
-C
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Update_6d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Update_6d(TypeUpdate,parent,child,tab,deb,fin)
-C
-CCC   Description:
-CCC   Subroutine to update a 6D grid variable on the parent grid.
-C
-C     Declarations:
-C
-      
-C
-C     Arguments      
-      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
-      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
-      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations 
-                                              ! are done on the fine grid       
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1),
-     &         child%var%lb(2):child%var%ub(2),
-     &         child%var%lb(3):child%var%ub(3),
-     &         child%var%lb(4):child%var%ub(4),
-     &         child%var%lb(5):child%var%ub(5),
-     &         child%var%lb(6):child%var%ub(6)
-     &      ),  Target :: tab  ! Results
-C
-C
-C     Definition of a temporary AGRIF_PVariable data TYPE  
-      allocate(childtemp % var)
-C
-C     Pointer on the root variable
-      childtemp % var % root_var => child % var %root_var
-C      
-C     Number of dimensions of the grid variable
-      childtemp % var % nbdim = 6  
-C      
-C     Values on the current grid used for the update
-C      childtemp % var % array6 => tab      
-      
-      childtemp % var % lb = child % var % lb
-      childtemp % var % ub = child % var % ub  
-            
-C      childtemp % var % list_update => child%var%list_update
-C
-      Call Agrif_UpdateVariable
-     &     (TypeUpdate,parent,child,deb,fin)
-     
-C      child % var % list_update => childtemp%var%list_update
-           
-C      
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Update_6D
-C
-C
-C
-C     **************************************************************************  
-C     Subroutine Agrif_UpdateVariable    
-C     **************************************************************************  
-C   
-      Subroutine Agrif_UpdateVariable(TypeUpdate,parent,child,deb,fin,
-     &                   procname)   
-C
-CCC   Description:
-CCC   Subroutine to set arguments of Agrif_UpdatenD, n being the number of
-C         dimensions of the grid variable.
-C
-CC    Declarations:
-C      
-c      
-C      
-C     Scalar argument
-      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
-C     Data TYPE arguments
-      TYPE(AGRIF_PVariable) :: parent   ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child    ! Variable on the child grid 
-      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations 
-                                        !    are calculated     
-      External :: procname
-      Optional ::  procname
-      
-C
-C     Local scalars      
-      INTEGER :: nbdim                  ! Number of dimensions of the current
-                                        !    grid
-      INTEGER ,DIMENSION(6) :: pttab_child  
-      INTEGER ,DIMENSION(6) :: petab_child      
-      INTEGER ,DIMENSION(6) :: pttab_parent  
-      REAL    ,DIMENSION(6) :: s_child,s_parent
-      REAL    ,DIMENSION(6) :: ds_child,ds_parent
-      INTEGER,DIMENSION(6)          :: loctab_Child ! Indicates if the child
-                                        !    grid has a common border with 
-                                        !    the root grid            
-      TYPE(AGRIF_Variable), Pointer :: root               ! Variable on the root grid
-      INTEGER,DIMENSION(6)          :: posvartab_Child    ! Position of the
-                                        !    variable on the cell
-      INTEGER,DIMENSION(6)          :: nbtab_Child        ! Number of the cells    
-      INTEGER :: n              
-      LOGICAL :: wholeupdate
-C
-C 
-
-      loctab_child(:) = 0
-C
-      root => child % var % root_var 
-      nbdim = root % nbdim
-C
-      do n = 1,nbdim
-        posvartab_child(n) = root % posvar(n)
-      enddo
-C      
-      
-      Call PreProcessToInterpOrUpdate(parent,child,
-     &             petab_Child(1:nbdim),
-     &             pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
-     &             s_Child(1:nbdim),s_Parent(1:nbdim),
-     &             ds_Child(1:nbdim),ds_Parent(1:nbdim),
-     &             nbdim)
-C
-C
-      do n = 1,nbdim
-C
-        Select case(root % interptab(n))
-C
-          case('x') ! x DIMENSION
-C
-            nbtab_Child(n) = Agrif_Curgrid % nb(1)
-C
-          case('y') ! y DIMENSION      
-C
-            nbtab_Child(n) = Agrif_Curgrid % nb(2)
-C
-          case('z') ! z DIMENSION
-C
-            nbtab_Child(n) = Agrif_Curgrid % nb(3)
-C
-          case('N') ! No space DIMENSION      
-C
-            
-            nbtab_Child(n) = child % var % ub(n) - child % var % lb(n)
-C
-C           No interpolation but only a copy of the values of the grid variable      
-C      
-            posvartab_child(n) = 1
-            
-            loctab_child(n) = -3
-C
-        End select
-C
-      enddo
-      
-C     Call to a procedure of update according to the number of dimensions of
-C     the grid variable
-
-      wholeupdate = .FALSE.
-      
-      do n=1,nbdim
-      if (loctab_child(n) /= -3) then
-        if (deb(n)>fin(n)) wholeupdate = .TRUE.
-        if ((deb(n) == -99).AND.(deb(n)==fin(n))) wholeupdate=.TRUE.
-      endif
-      enddo
-
-       IF (present(procname)) THEN
-
-          IF (wholeupdate) THEN
-
-          Call AGRIF_UpdateWhole
-     &         (TypeUpdate,parent,child,deb,fin,
-     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
-     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
-     &          loctab_Child(1:nbdim),
-     &          s_Child(1:nbdim),s_Parent(1:nbdim),
-     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim,procname)  
-         ELSE
-          Call AGRIF_UpdateBcnD
-     &         (TypeUpdate,parent,child,deb,fin,
-     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
-     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
-     &          loctab_Child(1:nbdim),
-     &          s_Child(1:nbdim),s_Parent(1:nbdim),
-     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim,procname)  
-         ENDIF
-       ELSE
-         IF (wholeupdate) THEN
-          Call AGRIF_UpdateWhole
-     &         (TypeUpdate,parent,child,deb,fin,
-     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
-     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
-     &          loctab_Child(1:nbdim),
-     &          s_Child(1:nbdim),s_Parent(1:nbdim),
-     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim)
-         ELSE
-          Call AGRIF_UpdateBcnD
-     &         (TypeUpdate,parent,child,deb,fin,
-     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
-     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
-     &          loctab_Child(1:nbdim),
-     &          s_Child(1:nbdim),s_Parent(1:nbdim),
-     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim)
-         ENDIF
-       ENDIF
-C
-      Return
-C
-C
-      End subroutine Agrif_UpdateVariable
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_UpdateWhole
-C     **************************************************************************               
-C
-      Subroutine AGRIF_UpdateWhole(TypeUpdate,parent,child,deb,fin,
-     &                           pttab_child,pttab_Parent,
-     &                           nbtab_Child,posvartab_Child,
-     &                           loctab_Child,
-     &                           s_Child,s_Parent,
-     &                           ds_Child,ds_Parent,nbdim,procname)
-C
-CCC   Description:
-CCC   Subroutine to calculate the boundary conditions for a nD grid variable on 
-CCC   a fine grid by using a space and time interpolations; it is called by the 
-CCC   Agrif_CorrectVariable procedure.
-C
-C
-C     Declarations:
-C
-      
-C
-#ifdef key_mpp_mpi
-C
-      INCLUDE 'mpif.h'
-C
-#endif
-C
-C     Arguments
-      INTEGER, DIMENSION(6) :: TypeUpdate            ! TYPE of update (copy or
-                                                     !    average) 
-      TYPE(AGRIF_PVariable)    :: parent             ! Variable on the parent
-                                                     !    grid
-      TYPE(AGRIF_PVariable)    :: child              ! Variable on the child
-                                                     !    grid 
-      INTEGER, DIMENSION(6) :: deb, fin
-      INTEGER                  :: nbdim              ! Number of dimensions of
-                                                     !    the grid variable
-      INTEGER,DIMENSION(nbdim) :: pttab_child        ! Index of the first point
-                                                     !    inside the domain for
-                                                     !    the parent grid
-                                                     !    variable
-      INTEGER,DIMENSION(nbdim) :: pttab_Parent       ! Index of the first point
-                                                     !    inside the domain for
-                                                     !    the child grid
-                                                     !    variable
-      INTEGER,DIMENSION(nbdim) :: nbtab_Child        ! Number of cells of the
-                                                     !    child grid
-      INTEGER,DIMENSION(nbdim) :: posvartab_Child    ! Position of the grid
-                                                     !    variable (1 or 2)
-      INTEGER,DIMENSION(nbdim) :: loctab_Child       ! Indicates if the child
-                                                     !    grid has a common
-                                                     !    border with the root
-                                                     !    grid
-      REAL   ,DIMENSION(nbdim) :: s_Child,s_Parent   ! Positions of the parent
-                                                     !    and child grids 
-      REAL   ,DIMENSION(nbdim) :: ds_Child,ds_Parent ! Space steps of the parent
-                                                     !    and child grids
-      External :: procname
-      Optional ::  procname      
-C
-C     Local variables     
-      INTEGER,DIMENSION(nbdim,2)   :: lubglob
-      INTEGER                      :: i                 
-      INTEGER,DIMENSION(nbdim,2,2) :: indtab         ! Arrays indicating the
-                                                     !    limits of the child
-      INTEGER,DIMENSION(nbdim,2,2) :: indtruetab     ! grid variable where
-                                                     !   boundary conditions are
-      integer :: coeffraf
-      INTEGER :: debloc, finloc
-C
-#ifdef key_mpp_mpi
-C
-      INTEGER,DIMENSION(nbdim)   :: lb,ub
-      INTEGER,DIMENSION(nbdim,2) :: iminmaxg
-      INTEGER                    :: code
-C
-#endif
-C      
-C
-C indtab contains the limits for the fine grid points that will be used
-C in the update scheme
-
-      DO i = 1, nbdim
-        coeffraf = nint(ds_Parent(i)/ds_Child(i))
-        debloc = 0
-        finloc = nbtab_Child(i)/coeffraf - 1
-
-        IF (posvartab_child(i) == 1) THEN
-           finloc = finloc - 1
-        ENDIF
-
-        IF (deb(i) > fin(i)) THEN
-          debloc = deb(i)
-          finloc = finloc - deb(i)
-        ENDIF
-
-        indtab(i,1,1) = pttab_child(i) + (debloc + 1) * coeffraf
-        indtab(i,1,2) = pttab_child(i) + (finloc + 1) * coeffraf
-
-        IF (posvartab_child(i) == 1) THEN
-          IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN
-            indtab(i,1,1) = indtab(i,1,1) - (coeffraf - 1)
-            indtab(i,1,2) = indtab(i,1,2) + (coeffraf - 1)        
-          ELSE IF (TypeUpdate(i) .NE. Agrif_Update_Copy) THEN
-            indtab(i,1,1) = indtab(i,1,1) - coeffraf / 2
-            indtab(i,1,2) = indtab(i,1,2) + coeffraf / 2
-          ENDIF
-        ELSE
-          indtab(i,1,1) = indtab(i,1,1) - coeffraf
-          indtab(i,1,2) = indtab(i,1,2) - 1
-C at this point, indices are OK for an average          
-          IF ((TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting)) THEN
-            indtab(i,1,1) = indtab(i,1,1) - coeffraf/2
-            indtab(i,1,2) = indtab(i,1,2) + coeffraf/2
-          ENDIF
-        ENDIF
-        IF (loctab_child(i) == -3) THEN
-           indtab(i,1,1) = pttab_child(i)
-C
-               if (posvartab_child(i) == 1) then
-C
-               indtab(i,1,2) = pttab_child(i) + nbtab_child(i) 
-C
-               else
-C
-               indtab(i,1,2) = pttab_child(i) + nbtab_child(i) - 1
-               ENDIF
-        ENDIF
-      ENDDO
-
-C lubglob contains the global lbound and ubound of the child array
-C lubglob(:,1) : global lbound for each dimension
-C lubglob(:,2) : global lbound for each dimension
-
-#if !defined key_mpp_mpi
-        Call Agrif_nbdim_Get_bound_dimension(child % var,lubglob(:,1),
-     &               lubglob(:,2),nbdim)
-C
-#else
-C     
-        Call Agrif_nbdim_Get_bound_dimension(child % var,lb,ub,nbdim)
-      DO i = 1,nbdim
-C
-        Call Agrif_Invloc(lb(i),Agrif_Procrank,i,iminmaxg(i,1))
-        Call Agrif_Invloc(ub(i),Agrif_Procrank,i,iminmaxg(i,2))
-C
-      ENDDO
-C
-      iminmaxg(1:nbdim,2) = - iminmaxg(1:nbdim,2)
-      
-      CALL MPI_ALLREDUCE(iminmaxg,lubglob,2*nbdim,MPI_INTEGER,MPI_MIN,
-     &                     MPI_COMM_AGRIF,code)
-
-      lubglob(1:nbdim,2) = - lubglob(1:nbdim,2)      
-C
-#endif 
-C
-      indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1),
-     &     lubglob(1:nbdim,1))
-      indtruetab(1:nbdim,1,2) = min(indtab(1:nbdim,1,2),
-     &     lubglob(1:nbdim,2))
-
-C
-C
-           IF (present(procname)) THEN
-              Call Agrif_UpdatenD              
-     &             (TypeUpdate,parent,child,
-     &              indtruetab(1:nbdim,1,1),indtruetab(1:nbdim,1,2),
-     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
-     &              s_Child(1:nbdim),s_Parent(1:nbdim),
-     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
-     &              posvartab_child,loctab_Child,
-     &              nbdim,procname)
-           ELSE
-              Call Agrif_UpdatenD              
-     &             (TypeUpdate,parent,child,
-     &              indtruetab(1:nbdim,1,1),indtruetab(1:nbdim,1,2),
-     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
-     &              s_Child(1:nbdim),s_Parent(1:nbdim),
-     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
-     &              posvartab_child,loctab_Child,
-     &              nbdim)           
-           ENDIF        
-C
-C      
-C  
-      End Subroutine Agrif_UpdateWhole
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_UpdateBcnd
-C     **************************************************************************               
-C
-      Subroutine AGRIF_UpdateBcnd(TypeUpdate,parent,child,deb,fin,
-     &                           pttab_child,pttab_Parent,
-     &                           nbtab_Child,posvartab_Child,
-     &                           loctab_Child,
-     &                           s_Child,s_Parent,
-     &                           ds_Child,ds_Parent,nbdim,procname)
-C
-CCC   Description:
-CCC   Subroutine to calculate the boundary conditions for a nD grid variable on
-CCC   a fine grid by using a space and time interpolations; it is called by the 
-CCC   Agrif_CorrectVariable procedure.
-C
-C
-C     Declarations:
-C
-      
-C
-#ifdef key_mpp_mpi
-C
-       INCLUDE 'mpif.h'
-C
-#endif
-C
-C     Arguments
-      INTEGER, DIMENSION(6) :: TypeUpdate            ! TYPE of update 
-                                                     !   (copy or average) 
-      TYPE(AGRIF_PVariable)    :: parent             ! Variable on the parent
-                                                     !   grid
-      TYPE(AGRIF_PVariable)    :: child              ! Variable on the child
-                                                     !   grid 
-      INTEGER, DIMENSION(6) :: deb, fin
-      INTEGER                  :: nbdim              ! Number of dimensions of
-                                                     !   the grid variable
-      INTEGER,DIMENSION(nbdim) :: pttab_child        ! Index of the first point
-                                                     !   inside the domain for
-                                                     !   the parent grid
-                                                     !   variable
-      INTEGER,DIMENSION(nbdim) :: pttab_Parent       ! Index of the first point
-                                                     !   inside the domain for
-                                                     !   the child grid variable
-      INTEGER,DIMENSION(nbdim) :: nbtab_Child        ! Number of cells of the
-                                                     !   child grid
-      INTEGER,DIMENSION(nbdim) :: posvartab_Child    ! Position of the grid
-                                                     !   variable (1 or 2)
-      INTEGER,DIMENSION(nbdim) :: loctab_Child       ! Indicates if the child
-                                                     !   grid has a common
-                                                     !   border with the root
-                                                     !   grid
-      REAL   ,DIMENSION(nbdim) :: s_Child,s_Parent   ! Positions of the parent
-                                                     !   and child grids 
-      REAL   ,DIMENSION(nbdim) :: ds_Child,ds_Parent ! Space steps of the parent
-                                                     !   and child grids
-      External :: procname
-      Optional ::  procname      
-C
-C     Local variables
-      INTEGER,DIMENSION(nbdim,2)   :: lubglob
-      INTEGER                      :: i                 
-      INTEGER,DIMENSION(nbdim,2,2) :: indtab         ! Arrays indicating the
-                                                     !   limits of the child
-      INTEGER,DIMENSION(nbdim,2,2) :: indtruetab     ! grid variable where
-                                                     !  boundary conditions are 
-      INTEGER,DIMENSION(nbdim,2,2,nbdim)   :: ptres      ! calculated
-      INTEGER                      :: nb,ndir,n
-      integer :: coeffraf
-C
-#ifdef key_mpp_mpi
-C
-      INTEGER,DIMENSION(nbdim)   :: lb,ub
-      INTEGER,DIMENSION(nbdim,2) :: iminmaxg
-      INTEGER                    :: code
-C
-#endif
-C      
-C
-
-      DO i = 1, nbdim
-        coeffraf = nint(ds_Parent(i)/ds_Child(i))
-        indtab(i,1,1) = pttab_child(i) + (deb(i) + 1) * coeffraf
-        indtab(i,1,2) = pttab_child(i) + (fin(i) + 1) * coeffraf
-
-        indtab(i,2,1) = pttab_child(i) + nbtab_child(i)
-     &    - (fin(i) + 1) *  coeffraf
-        indtab(i,2,2) = pttab_child(i) + nbtab_child(i)
-     &    - (deb(i) + 1) *  coeffraf
-
-        IF (posvartab_child(i) == 1) THEN
-          IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN
-            indtab(i,:,1) = indtab(i,:,1) - (coeffraf - 1)
-            indtab(i,:,2) = indtab(i,:,2) + (coeffraf - 1)        
-          ELSE IF (TypeUpdate(i) .NE. Agrif_Update_Copy) THEN
-            indtab(i,:,1) = indtab(i,:,1) - coeffraf / 2
-            indtab(i,:,2) = indtab(i,:,2) + coeffraf / 2
-          ENDIF
-        ELSE
-          indtab(i,1,1) = indtab(i,1,1) - coeffraf
-          indtab(i,1,2) = indtab(i,1,2) - 1
-          indtab(i,2,2) = indtab(i,2,2) + coeffraf - 1
-          IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN
-            indtab(i,1,1) = indtab(i,1,1) - coeffraf/2
-            indtab(i,1,2) = indtab(i,1,2) + coeffraf/2
-            indtab(i,2,1) = indtab(i,2,1) - coeffraf/2
-            indtab(i,2,2) = indtab(i,2,2) + coeffraf/2
-          ENDIF          
-        ENDIF
-      ENDDO
-
-#if !defined key_mpp_mpi      
-        Call Agrif_nbdim_Get_bound_dimension(child % var,lubglob(:,1),
-     &               lubglob(:,2),nbdim)
-
-C
-#else
-C     
-        Call Agrif_nbdim_Get_bound_dimension(child % var,lb,ub,nbdim)
-      DO i = 1,nbdim
-C
-        Call Agrif_Invloc(lb(i),Agrif_Procrank,i,iminmaxg(i,1))
-        Call Agrif_Invloc(ub(i),Agrif_Procrank,i,iminmaxg(i,2))
-C
-      ENDDO
-C
-      iminmaxg(1:nbdim,2) = - iminmaxg(1:nbdim,2)
-      
-      CALL MPI_ALLREDUCE(iminmaxg,lubglob,2*nbdim,MPI_INTEGER,MPI_MIN,
-     &                     MPI_COMM_AGRIF,code)  
-     
-      lubglob(1:nbdim,2) = - lubglob(1:nbdim,2)      
-C
-#endif 
-C     
-      indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1),
-     &     lubglob(1:nbdim,1))
-      indtruetab(1:nbdim,1,2) = max(indtab(1:nbdim,1,2),
-     &     lubglob(1:nbdim,1))
-      indtruetab(1:nbdim,2,1) = min(indtab(1:nbdim,2,1),
-     &     lubglob(1:nbdim,2))
-      indtruetab(1:nbdim,2,2) = min(indtab(1:nbdim,2,2),
-     &     lubglob(1:nbdim,2))
-                        
-C 
-C
-      do nb = 1,nbdim
-C
-        do ndir = 1,2
-C
-          if (loctab_child(nb) /= -3) then
-C           
-              do n = 1,2
-C
-                ptres(nb,n,ndir,nb) = indtruetab(nb,ndir,n)
-C
-              enddo              
-C
-              do i = 1,nbdim
-C     
-                if (i .NE. nb) then      
-C
-                    if (loctab_child(i) == -3) then
-C
-                        ptres(i,1,ndir,nb) = pttab_child(i)
-C
-                      else
-C
-                        ptres(i,1,ndir,nb) = indtruetab(i,1,1)
-C
-                    endif
-C
-                    if (loctab_child(i) == -3) then
-C
-                        if (posvartab_child(i) == 1) then
-C
-                            ptres(i,2,ndir,nb) = pttab_child(i) 
-     &                                + nbtab_child(i)
-C
-                          else
-C
-                            ptres(i,2,ndir,nb) = pttab_child(i) 
-     &                             + nbtab_child(i) - 1
-C
-                        endif                             
-C
-                      else
-C
-                        ptres(i,2,ndir,nb) = indtruetab(i,2,2)
-C
-                    endif                        
-C      
-                endif
-C      
-              enddo
-      
-C
-            
-        endif
-      
-        enddo
-       enddo
-C
-
-C
-
-      do nb = 1,nbdim
-C
-        do ndir = 1,2                
-C
-          if (loctab_child(nb) /= -3) then
-C
-           IF (present(procname)) THEN
-              Call Agrif_UpdatenD              
-     &             (TypeUpdate,parent,child,
-     &              ptres(1:nbdim,1,ndir,nb),ptres(1:nbdim,2,ndir,nb),
-     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
-     &              s_Child(1:nbdim),s_Parent(1:nbdim),
-     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
-     &              posvartab_Child,loctab_Child,
-     &              nbdim,procname,nb,ndir)
-           ELSE
-              Call Agrif_UpdatenD              
-     &             (TypeUpdate,parent,child,
-     &              ptres(1:nbdim,1,ndir,nb),ptres(1:nbdim,2,ndir,nb),
-     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
-     &              s_Child(1:nbdim),s_Parent(1:nbdim),
-     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
-     &              posvartab_Child,loctab_Child,
-     &              nbdim)           
-           ENDIF
-C
-          endif
-          
-C
-        enddo       
-C
-      enddo
-C
-C      
-C  
-      End Subroutine Agrif_UpdateBcnd
-C
-C     **************************************************************************  
-CCC   Subroutine Agrif_UpdatenD  
-C     **************************************************************************  
-C  
-      Subroutine Agrif_UpdatenD(TypeUpdate,parent,child,
-     &                          pttab,petab,
-     &                          pttab_Child,pttab_Parent,
-     &                          s_Child,s_Parent,
-     &                          ds_Child,ds_Parent,
-     &                          posvartab_Child,loctab_Child,
-     &                          nbdim,procname,nb,ndir)  
-C
-C     Description:
-C     Subroutine to update a 2D grid variable on the parent grid of 
-C        the current grid. 
-C
-C     Declarations:
-C
-      
-C
-#ifdef key_mpp_mpi
-C
-       INCLUDE 'mpif.h'
-C
-#endif
-C
-C     Arguments
-      INTEGER                    :: nbdim
-      INTEGER, DIMENSION(6) :: TypeUpdate              ! TYPE of update 
-                                                       !  (copy or average)
-      TYPE(AGRIF_PVARIABLE)      :: parent             ! Variable of the parent
-                                                       !   grid   
-      TYPE(AGRIF_PVARIABLE)      :: child              ! Variable of the child
-                                                       !   grid
-      INTEGER,DIMENSION(nbdim)   :: pttab              ! Index of the first
-                                                       !   point inside the
-                                                       !   domain
-      INTEGER,DIMENSION(nbdim)   :: petab              ! Index of the first
-                                                       !   point inside the
-                                                       !   domain
-      INTEGER,DIMENSION(nbdim)   :: pttab_Child        ! Index of the first
-                                                       !   point inside the
-                                                       !   domain for the child
-                                                       !   grid variable
-      INTEGER,DIMENSION(nbdim)   :: pttab_Parent       ! Index of the first
-                                                       !   point inside the
-                                                       !   domain for the parent
-                                                       !   grid variable
-      REAL,DIMENSION(nbdim)      :: s_Child,s_Parent   ! Positions of the parent
-                                                       !   and child grids
-      REAL,DIMENSION(nbdim)      :: ds_Child,ds_Parent ! Space steps of the
-                                                       !   parent and child
-                                                       !   grids 
-      External :: procname
-      Optional ::  procname
-      Integer :: nb,ndir
-      Optional :: nb,ndir
-      
-C
-C     Local pointers
-      TYPE(AGRIF_PVARIABLE), SAVE      :: tempP      ! Temporary parent grid variable
-      TYPE(AGRIF_PVARIABLE), SAVE      :: tempC      ! Temporary child grid variable
-C
-C     Local scalars
-      INTEGER,DIMENSION(nbdim)    :: pttruetab,cetruetab
-      INTEGER,DIMENSION(nbdim)    :: posvartab_Child,loctab_Child
-      INTEGER,DIMENSION(nbdim)    :: indmin,indmax
-      INTEGER,DIMENSION(nbdim)    :: indminglob,indmaxglob
-      REAL   ,DIMENSION(nbdim)    :: s_Child_temp,s_Parent_temp
-cccccccc      LOGICAL,DIMENSION(nbdim)    :: noraftab
-      INTEGER,DIMENSION(nbdim)    :: lowerbound,upperbound
-      LOGICAL :: memberin, member
-      INTEGER,DIMENSION(nbdim)    :: pttruetabwhole,cetruetabwhole
-      INTEGER,DIMENSION(nbdim,2,2) :: childarray
-      INTEGER,DIMENSION(nbdim,2,2) :: parentarray
-      TYPE(AGRIF_PVARIABLE), SAVE      :: tempCextend,tempPextend ! Temporary child
-      INTEGER :: nbin, ndirin
-C
-#ifdef key_mpp_mpi
-C
-      INTEGER,DIMENSION(nbdim)    :: indminglob2,indmaxglob2
-      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1
-      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc2,recvfromproc2      
-      INTEGER                              :: code
-      INTEGER                              :: i,j,k
-      INTEGER,DIMENSION(nbdim,4)           :: tab3
-      INTEGER,DIMENSION(nbdim,4,0:Agrif_Nbprocs-1) :: tab4
-      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
-      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab5t      
-      LOGICAL :: find_list_update
-      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall, memberinall2
-      LOGICAL, DIMENSION(1) :: memberin1      
-C
-#endif
-C
-  
-C
-C     local lbound and ubound of the child array
-
-      Call Agrif_nbdim_Get_bound_dimension(child%var,
-     &                              lowerbound,upperbound,nbdim)
-
-C here pttab and petab corresponds to the (global) indices of the points needed
-C in the update
-C pttruetab and cetruetab contains only indices that are present
-C on the local processor
-
-      Call Agrif_Childbounds(nbdim,
-     &                       lowerbound,upperbound,
-     &                       pttab,petab,
-     &                       pttruetab,cetruetab,memberin)
-
-       Call Agrif_Prtbounds(nbdim,indminglob,indmaxglob,s_Parent_temp,
-     &                     s_Child_temp,s_Child,ds_Child,
-     &                     s_Parent,ds_Parent,
-     &                     pttab,petab,pttab_Child,
-     &                     pttab_Parent,
-     &                     posvartab_Child,TypeUpdate,loctab_Child
-#ifdef key_mpp_mpi
-     &                 ,pttruetabwhole,cetruetabwhole
-#endif
-     &     )
-
-#ifdef key_mpp_mpi
-      IF (memberin) THEN
-       Call Agrif_GlobtoLocInd2(childarray,
-     &                     lowerbound,upperbound,
-     &                     pttruetab,cetruetab,
-     &                     nbdim,Agrif_Procrank,
-     &                     member)
-
-      ENDIF
-
-
-         Call Agrif_Prtbounds(nbdim,indmin,indmax,s_Parent_temp,
-     &                     s_Child_temp,s_Child,ds_Child,
-     &                     s_Parent,ds_Parent,
-     &                     pttruetab,cetruetab,pttab_Child,
-     &                     pttab_Parent,
-     &                     posvartab_Child,TypeUpdate,loctab_Child
-     &                 ,pttruetabwhole,cetruetabwhole
-     &     )
-
-#else
-       indmin = indminglob
-       indmax = indmaxglob
-       pttruetabwhole = pttruetab
-       cetruetabwhole = cetruetab
-       childarray(:,1,2) = pttruetab
-       childarray(:,2,2) = cetruetab
-#endif
-
-       IF (present(procname)) THEN
-       IF (.Not.present(nb)) THEN
-       nbin=0
-       ndirin=0
-       ELSE
-       nbin = nb
-       ndirin = ndir
-       ENDIF
-       ENDIF
-       
-      IF (memberin) THEN
-      IF (.not.associated(tempC%var)) allocate(tempC%var)
-
-C
-      Call Agrif_nbdim_allocation(tempC%var,
-     &                 pttruetab,cetruetab,nbdim)
-
-      Call Agrif_nbdim_Full_VarEQreal(tempC%var,0.,nbdim)
-
-      IF (present(procname)) THEN
-        SELECT CASE (nbdim)
-        CASE(1)
-          CALL procname(tempC%var%array1,
-     &                          childarray(1,1,2),childarray(1,2,2),
-     &                                   .TRUE.,nbin,ndirin)
-        CASE(2)
-          CALL procname(tempC%var%array2,
-     &                          childarray(1,1,2),childarray(1,2,2),
-     &                          childarray(2,1,2),childarray(2,2,2),
-     &                                   .TRUE.,nbin,ndirin)
-        CASE(3)
-          CALL procname(tempC%var%array3,
-     &                          childarray(1,1,2),childarray(1,2,2),
-     &                          childarray(2,1,2),childarray(2,2,2),
-     &                          childarray(3,1,2),childarray(3,2,2),
-     &                                   .TRUE.,nbin,ndirin)
-        CASE(4)
-          CALL procname(tempC%var%array4,
-     &                          childarray(1,1,2),childarray(1,2,2),
-     &                          childarray(2,1,2),childarray(2,2,2),
-     &                          childarray(3,1,2),childarray(3,2,2),
-     &                          childarray(4,1,2),childarray(4,2,2),
-     &                                   .TRUE.,nbin,ndirin)
-        CASE(5)
-          CALL procname(tempC%var%array5,
-     &                          childarray(1,1,2),childarray(1,2,2),
-     &                          childarray(2,1,2),childarray(2,2,2),
-     &                          childarray(3,1,2),childarray(3,2,2),
-     &                          childarray(4,1,2),childarray(4,2,2),
-     &                          childarray(5,1,2),childarray(5,2,2),
-     &                                   .TRUE.,nbin,ndirin)
-        CASE(6)
-          CALL procname(tempC%var%array6,
-     &                          childarray(1,1,2),childarray(1,2,2),
-     &                          childarray(2,1,2),childarray(2,2,2),
-     &                          childarray(3,1,2),childarray(3,2,2),
-     &                          childarray(4,1,2),childarray(4,2,2),
-     &                          childarray(5,1,2),childarray(5,2,2),
-     &                          childarray(6,1,2),childarray(6,2,2),
-     &                                   .TRUE.,nbin,ndirin)
-        END SELECT
-      ELSE
-      Call Agrif_nbdim_VarEQvar(tempC%var,pttruetab,cetruetab,
-     &          child%var,childarray(:,1,2),childarray(:,2,2),
-     &                          nbdim)
-      ENDIF
-
-      ENDIF
-
-
-
-C
-C
-#ifdef key_mpp_mpi
-C
-C     tab2 contains the necessary limits of the parent grid for each processor
-
-      IF (Associated(child%var%list_update)) THEN
-      Call Agrif_Find_list_update(child%var%list_update,pttab,petab,
-     &                          pttab_Child,pttab_Parent,nbdim,
-     &       find_list_update,tab4t,tab5t,memberinall,memberinall2,
-     &     sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2)
-      ELSE
-      find_list_update = .FALSE.
-      ENDIF
-      
-      if (.not.find_list_update) then      
-      tab3(:,1) = pttruetab(:)
-      tab3(:,2) = cetruetab(:)
-      tab3(:,3) = pttruetabwhole(:)
-      tab3(:,4) = cetruetabwhole(:)
-C
-C
-      Call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,
-     &                   MPI_INTEGER,MPI_COMM_AGRIF,code)
-
-      IF (.not.associated(tempCextend%var)) Allocate(tempCextend%var)
-      DO k=0,Agrif_Nbprocs-1
-       do j=1,4
-         do i=1,nbdim
-         tab4t(i,k,j) = tab4(i,j,k)
-         enddo
-       enddo
-      enddo
-      
-      memberin1(1) = memberin
-      CALL MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall,
-     &                  1,MPI_LOGICAL,MPI_COMM_AGRIF,code)
- 
-       Call Get_External_Data_first(tab4t(:,:,1),
-     &            tab4t(:,:,2),
-     &            tab4t(:,:,3),tab4t(:,:,4),nbdim,memberin,memberin,
-     &            memberinall,sendtoproc1,recvfromproc1,tab4t(:,:,5),
-     & tab4t(:,:,6),tab4t(:,:,7),tab4t(:,:,8))
-               
-      endif
-
-      Call ExchangeSameLevel2(sendtoproc1,recvfromproc1,nbdim,
-     &            tab4t(:,:,3),tab4t(:,:,4),tab4t(:,:,5),tab4t(:,:,6),
-     &            tab4t(:,:,7),tab4t(:,:,8),memberin,tempC,
-     &            tempCextend) 
-           
-!      Call Get_External_Data(tempC,tempCextend,tab4t(:,:,1),
-!     &            tab4t(:,:,2),
-!     &            tab4t(:,:,3),tab4t(:,:,4),nbdim,memberin,memberin,
-!     &            memberinall)
-
-#else
-      tempCextend%var => tempC%var
-#endif
-
-C
-C
-C     Update of the parent grid (tempP) from the child grid (tempC)
-
-
-      IF (memberin) THEN
-
-      IF (.not.associated(tempP%var)) allocate(tempP%var)
-      Call Agrif_nbdim_allocation(tempP%var,
-     &                 indmin,indmax,nbdim)
-
-      if ( nbdim .EQ. 1 ) then
-         tempP%var%array1 = 0.
-         Call Agrif_Update_1D_recursive(TypeUpdate,
-     &           tempP%var%array1,tempCextend%var%array1,
-     &           indmin,indmax,
-     &           pttruetabwhole,cetruetabwhole,
-     &           s_Child_temp,s_Parent_temp,
-     &           ds_Child,ds_Parent,nbdim)
-      endif
-      if ( nbdim .EQ. 2 ) then
-         Call Agrif_Update_2D_recursive(TypeUpdate,
-     &           tempP%var%array2,tempCextend%var%array2,
-     &           indmin,indmax,
-     &           pttruetabwhole,cetruetabwhole,
-     &           s_Child_temp,s_Parent_temp,
-     &           ds_Child,ds_Parent,nbdim)
-      endif
-
-      if ( nbdim .EQ. 3 ) then
-         Call Agrif_Update_3D_recursive(TypeUpdate,
-     &           tempP%var%array3,tempCextend%var%array3,
-     &           indmin,indmax,
-     &           pttruetabwhole,cetruetabwhole,
-     &           s_Child_temp,s_Parent_temp,
-     &           ds_Child,ds_Parent,nbdim)
-      endif
-      if ( nbdim .EQ. 4 ) then
-         Call Agrif_Update_4D_recursive(TypeUpdate,
-     &           tempP%var%array4,tempCextend%var%array4,
-     &           indmin,indmax,
-     &           pttruetabwhole,cetruetabwhole,
-     &           s_Child_temp,s_Parent_temp,
-     &           ds_Child,ds_Parent,nbdim)
-      endif
-      if ( nbdim .EQ. 5 ) then
-         Call Agrif_Update_5D_recursive(TypeUpdate,
-     &           tempP%var%array5,tempCextend%var%array5,
-     &           indmin,indmax,
-     &           pttruetabwhole,cetruetabwhole,
-     &           s_Child_temp,s_Parent_temp,
-     &           ds_Child,ds_Parent,nbdim)
-      endif
-      if ( nbdim .EQ. 6 ) then
-         Call Agrif_Update_6D_recursive(TypeUpdate,
-     &           tempP%var%array6,tempCextend%var%array6,
-     &           indmin,indmax,
-     &           pttruetabwhole,cetruetabwhole,
-     &           s_Child_temp,s_Parent_temp,
-     &           ds_Child,ds_Parent,nbdim)
-      endif
-
-      Call Agrif_nbdim_deallocation(tempCextend%var,nbdim)
-C      Deallocate(tempCextend%var)
-
-      ENDIF
-
-#ifdef key_mpp_mpi
-      Call Agrif_nbdim_Get_bound_dimension(parent%var,
-     &                              lowerbound,upperbound,nbdim)
-
-      Call Agrif_ChildGrid_to_ParentGrid()
-C
-      Call Agrif_Childbounds(nbdim,
-     &                       lowerbound,upperbound,
-     &                       indminglob,indmaxglob,
-     &                       indminglob2,indmaxglob2,member)
-C
-      IF (member) THEN
-      Call Agrif_GlobtoLocInd2(parentarray,
-     &                     lowerbound,upperbound,
-     &                     indminglob2,indmaxglob2,
-     &                     nbdim,Agrif_Procrank,
-     &                     member)
-      ENDIF
-
-      Call Agrif_ParentGrid_to_ChildGrid()
-
-      if (.not.find_list_update) then
-      tab3(:,1) = indmin(:)
-      tab3(:,2) = indmax(:)
-      tab3(:,3) = indminglob2(:)
-      tab3(:,4) = indmaxglob2(:)
-C
-      Call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,
-     &                   MPI_INTEGER,MPI_COMM_AGRIF,code)
-
-      IF (.not.associated(tempPextend%var)) Allocate(tempPextend%var)
-      DO k=0,Agrif_Nbprocs-1
-       do j=1,4
-         do i=1,nbdim
-         tab5t(i,k,j) = tab4(i,j,k)
-         enddo
-       enddo
-      enddo
- 
-      memberin1(1) = member
-      CALL MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall2,
-     &                  1,MPI_LOGICAL,MPI_COMM_AGRIF,code)
- 
-      Call Get_External_Data_first(tab5t(:,:,1),
-     &            tab5t(:,:,2),
-     &            tab5t(:,:,3),tab5t(:,:,4),nbdim,memberin,member,
-     &            memberinall2,sendtoproc2,recvfromproc2,tab5t(:,:,5),
-     & tab5t(:,:,6),tab5t(:,:,7),tab5t(:,:,8))
-          
-      Call Agrif_Addto_list_update(child%var%list_update,pttab,petab,
-     &                          pttab_Child,pttab_Parent,nbdim
-     &   ,tab4t,tab5t,memberinall,memberinall2,
-     &   sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2) 
-          
-      endif
-      
-c      Call Get_External_Data(tempP,tempPextend,tab5t(:,:,1),
-c     &            tab5t(:,:,2),
-c     &            tab5t(:,:,3),tab5t(:,:,4),nbdim,memberin,member,
-c     &            memberinall2)
-     
-      Call ExchangeSameLevel2(sendtoproc2,recvfromproc2,nbdim,
-     &            tab5t(:,:,3),tab5t(:,:,4),tab5t(:,:,5),tab5t(:,:,6),
-     &            tab5t(:,:,7),tab5t(:,:,8),member,tempP,
-     &            tempPextend)     
-
-#else
-      tempPextend%var => tempP%var
-      parentarray(:,1,1) = indmin
-      parentarray(:,2,1) = indmax
-      parentarray(:,1,2) = indmin
-      parentarray(:,2,2) = indmax
-      member = .TRUE.
-#endif
-
-C
-C
-C
-C     Special values on the child grid
-      if (Agrif_UseSpecialValueFineGrid) then
-C
-ccc         noraftab(1:nbdim) =
-ccc     &    child % var % root_var % interptab(1:nbdim) .EQ. 'N'
-C
-#ifdef key_mpp_mpi
-C
-c          Allocate(childvalues% var)
-C
-c          Call Agrif_nbdim_allocation(childvalues%var,
-c     &                      pttruetab,cetruetab,nbdim)
-c          Call Agrif_nbdim_Full_VarEQvar(childvalues% var,
-c     &                                tempC% var,
-c     &                                nbdim)
-c          Call Agrif_CheckMasknD(tempC,childvalues,
-c     &                           pttruetab(1:nbdim),cetruetab(1:nbdim),
-c     &                           pttruetab(1:nbdim),cetruetab(1:nbdim),
-c     &                           noraftab(1:nbdim),nbdim)
-c          Call Agrif_nbdim_deallocation(childvalues% var,nbdim)
-c         Deallocate(childvalues % var)
-C
-#else
-C
-c          Call Agrif_nbdim_Get_bound_dimension(child%var,
-c     &                              lowerbound,upperbound,nbdim)
-c          Call Agrif_CheckMasknD(tempC,child,
-c     &                           pttruetab(1:nbdim),cetruetab(1:nbdim),
-c     &                           lowerbound,
-c     &                           upperbound,
-c     &                           noraftab(1:nbdim),nbdim)
-C
-#endif
-C
-      endif
-
-
-C
-C
-C
-C
-C     Special values on the parent grid
-      if (Agrif_UseSpecialValue) then
-C
-#ifdef key_mpp_mpi
-C
-c          Call GiveAgrif_SpecialValueToTab_mpi(parent%var,tempP%var,
-c     &                 parentarray,
-c     &                 indmin,indmax,
-c     &                 Agrif_SpecialValue,nbdim)
-C
-C
-#else
-C
-c          Call GiveAgrif_SpecialValueToTab(parent%var,tempP%var,
-c     &                  indmin,indmax,
-c     &                  Agrif_SpecialValue,nbdim)
-C
-#endif
-C
-C
-      endif   
-C
-C
-        IF (member) THEN
-
-          IF (present(procname)) THEN
-            CALL Agrif_ChildGrid_to_ParentGrid()
-            SELECT CASE(nbdim)
-            CASE(1)
-            CALL procname(
-     &      tempPextend%var%array1(
-     &                      parentarray(1,1,1):parentarray(1,2,1)),
-     &                      parentarray(1,1,2),parentarray(1,2,2),
-     &                                   .FALSE.,nbin,ndirin
-     &                      )
-            CASE(2)
-            CALL procname(
-     &      tempPextend%var%array2(
-     &                      parentarray(1,1,1):parentarray(1,2,1),
-     &                      parentarray(2,1,1):parentarray(2,2,1)),
-     &                      parentarray(1,1,2),parentarray(1,2,2),
-     &                      parentarray(2,1,2),parentarray(2,2,2),
-     &                                   .FALSE.,nbin,ndirin
-     &                      )
-            CASE(3)
-            CALL procname(
-     &      tempPextend%var%array3(
-     &                      parentarray(1,1,1):parentarray(1,2,1),
-     &                      parentarray(2,1,1):parentarray(2,2,1),
-     &                      parentarray(3,1,1):parentarray(3,2,1)),
-     &                      parentarray(1,1,2),parentarray(1,2,2),
-     &                      parentarray(2,1,2),parentarray(2,2,2),
-     &                      parentarray(3,1,2),parentarray(3,2,2),
-     &                                   .FALSE.,nbin,ndirin
-     &                      )
-            CASE(4)
-            CALL procname(
-     &      tempPextend%var%array4(
-     &                      parentarray(1,1,1):parentarray(1,2,1),
-     &                      parentarray(2,1,1):parentarray(2,2,1),
-     &                      parentarray(3,1,1):parentarray(3,2,1),
-     &                      parentarray(4,1,1):parentarray(4,2,1)),
-     &                      parentarray(1,1,2),parentarray(1,2,2),
-     &                      parentarray(2,1,2),parentarray(2,2,2),
-     &                      parentarray(3,1,2),parentarray(3,2,2),
-     &                      parentarray(4,1,2),parentarray(4,2,2),
-     &                                   .FALSE.,nbin,ndirin
-     &                      )
-            CASE(5)
-            CALL procname(
-     &      tempPextend%var%array5(
-     &                      parentarray(1,1,1):parentarray(1,2,1),
-     &                      parentarray(2,1,1):parentarray(2,2,1),
-     &                      parentarray(3,1,1):parentarray(3,2,1),
-     &                      parentarray(4,1,1):parentarray(4,2,1),
-     &                      parentarray(5,1,1):parentarray(5,2,1)),
-     &                      parentarray(1,1,2),parentarray(1,2,2),
-     &                      parentarray(2,1,2),parentarray(2,2,2),
-     &                      parentarray(3,1,2),parentarray(3,2,2),
-     &                      parentarray(4,1,2),parentarray(4,2,2),
-     &                      parentarray(5,1,2),parentarray(5,2,2),
-     &                                   .FALSE.,nbin,ndirin
-     &                      )
-            CASE(6)
-            CALL procname(
-     &      tempPextend%var%array6(
-     &                      parentarray(1,1,1):parentarray(1,2,1),
-     &                      parentarray(2,1,1):parentarray(2,2,1),
-     &                      parentarray(3,1,1):parentarray(3,2,1),
-     &                      parentarray(4,1,1):parentarray(4,2,1),
-     &                      parentarray(5,1,1):parentarray(5,2,1),
-     &                      parentarray(6,1,1):parentarray(6,2,1)),
-     &                      parentarray(1,1,2),parentarray(1,2,2),
-     &                      parentarray(2,1,2),parentarray(2,2,2),
-     &                      parentarray(3,1,2),parentarray(3,2,2),
-     &                      parentarray(4,1,2),parentarray(4,2,2),
-     &                      parentarray(5,1,2),parentarray(5,2,2),
-     &                      parentarray(6,1,2),parentarray(6,2,2),
-     &                                   .FALSE.,nbin,ndirin
-     &                      )
-            END SELECT
-            CALL Agrif_ParentGrid_to_ChildGrid()
-          ELSE
-            SELECT CASE(nbdim)
-            CASE(1)
-            parent%var%array1(parentarray(1,1,2):parentarray(1,2,2)) =
-     &      tempPextend%var%array1(
-     &                      parentarray(1,1,1):parentarray(1,2,1))
-            CASE(2)
-            parent%var%array2(parentarray(1,1,2):parentarray(1,2,2),
-     &                      parentarray(2,1,2):parentarray(2,2,2)) =
-     &      tempPextend%var%array2(
-     &                      parentarray(1,1,1):parentarray(1,2,1),
-     &                      parentarray(2,1,1):parentarray(2,2,1))
-            CASE(3)
-            parent%var%array3(parentarray(1,1,2):parentarray(1,2,2),
-     &                      parentarray(2,1,2):parentarray(2,2,2),
-     &                      parentarray(3,1,2):parentarray(3,2,2)) =
-     &      tempPextend%var%array3(
-     &                      parentarray(1,1,1):parentarray(1,2,1),
-     &                      parentarray(2,1,1):parentarray(2,2,1),
-     &                      parentarray(3,1,1):parentarray(3,2,1))
-            CASE(4)
-            parent%var%array4(parentarray(1,1,2):parentarray(1,2,2),
-     &                      parentarray(2,1,2):parentarray(2,2,2),
-     &                      parentarray(3,1,2):parentarray(3,2,2),
-     &                      parentarray(4,1,2):parentarray(4,2,2)) =
-     &      tempPextend%var%array4(
-     &                      parentarray(1,1,1):parentarray(1,2,1),
-     &                      parentarray(2,1,1):parentarray(2,2,1),
-     &                      parentarray(3,1,1):parentarray(3,2,1),
-     &                      parentarray(4,1,1):parentarray(4,2,1))
-            CASE(5)
-            parent%var%array5(parentarray(1,1,2):parentarray(1,2,2),
-     &                      parentarray(2,1,2):parentarray(2,2,2),
-     &                      parentarray(3,1,2):parentarray(3,2,2),
-     &                      parentarray(4,1,2):parentarray(4,2,2),
-     &                      parentarray(5,1,2):parentarray(5,2,2)) =
-     &      tempPextend%var%array5(
-     &                      parentarray(1,1,1):parentarray(1,2,1),
-     &                      parentarray(2,1,1):parentarray(2,2,1),
-     &                      parentarray(3,1,1):parentarray(3,2,1),
-     &                      parentarray(4,1,1):parentarray(4,2,1),
-     &                      parentarray(5,1,1):parentarray(5,2,1))
-            CASE(6)
-            parent%var%array6(parentarray(1,1,2):parentarray(1,2,2),
-     &                      parentarray(2,1,2):parentarray(2,2,2),
-     &                      parentarray(3,1,2):parentarray(3,2,2),
-     &                      parentarray(4,1,2):parentarray(4,2,2),
-     &                      parentarray(5,1,2):parentarray(5,2,2),
-     &                      parentarray(6,1,2):parentarray(6,2,2)) =
-     &      tempPextend%var%array6(
-     &                      parentarray(1,1,1):parentarray(1,2,1),
-     &                      parentarray(2,1,1):parentarray(2,2,1),
-     &                      parentarray(3,1,1):parentarray(3,2,1),
-     &                      parentarray(4,1,1):parentarray(4,2,1),
-     &                      parentarray(5,1,1):parentarray(5,2,1),
-     &                      parentarray(6,1,1):parentarray(6,2,1))
-            END SELECT
-          ENDIF
-
-        Call Agrif_nbdim_deallocation(tempPextend%var,nbdim)
-       ENDIF
-C
-C
-C     Deallocations
-
-      IF (memberin) THEN
-#ifdef key_mpp_mpi
-      Call Agrif_nbdim_deallocation(tempP%var,nbdim)
-      Call Agrif_nbdim_deallocation(tempC%var,nbdim)
-!      Deallocate(tempC % var)
-#endif
-!      Deallocate(tempP % var)
-      ENDIF
-#ifdef key_mpp_mpi
-!      Deallocate(tempPextend%var)
-!      IF (.Not.memberin) Deallocate(tempCextend%var)
-#endif
-
-C
-C
-      End Subroutine Agrif_UpdatenD
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Prtbounds
-C     **************************************************************************
-C
-      Subroutine Agrif_Prtbounds(nbdim,indmin,indmax,s_Parent_temp,
-     &                              s_Child_temp,s_Child,ds_Child,
-     &                              s_Parent,ds_Parent,
-     &                              pttruetab,cetruetab,pttab_Child,
-     &                              pttab_Parent,
-     &                              posvartab_child,TypeUpdate,
-     &                              loctab_Child
-#ifdef key_mpp_mpi
-     &                 ,pttruetabwhole,cetruetabwhole
-#endif
-     &                 )
-C
-CCC   Description:
-CCC   Subroutine calculating the bounds of the parent grid to be updated
-CCC   by the child grid     
-C
-C
-C     Declarations:
-C
-      
-C
-#ifdef key_mpp_mpi
-cccccccccccccccccccccccccc#include "mpif.h"
-#endif
-C
-C     Arguments
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(nbdim) :: indmin,indmax
-      REAL,DIMENSION(nbdim) :: s_Parent_temp,s_child_temp
-      REAL,DIMENSION(nbdim) :: s_Child,ds_child
-      REAL,DIMENSION(nbdim) :: s_Parent,ds_Parent
-      INTEGER,DIMENSION(nbdim) :: pttruetab,cetruetab
-      INTEGER,DIMENSION(nbdim) :: posvartab_child,TypeUpdate
-      INTEGER,DIMENSION(nbdim) :: loctab_Child
-      INTEGER,DIMENSION(nbdim) :: pttab_Child,pttab_Parent
-C
-C     Local variables
-      INTEGER :: i
-      REAL,DIMENSION(nbdim) :: dim_newmin,dim_newmax      
-#ifdef key_mpp_mpi
-      INTEGER,DIMENSION(nbdim)    :: pttruetabwhole,cetruetabwhole
-      REAL :: positionmin,positionmax
-      INTEGER :: imin,imax
-      INTEGER :: coeffraf
-#endif
-C
-C
-      do i = 1,nbdim
-C
-        dim_newmin(i) = s_Child(i) + (pttruetab(i) -
-     &                                pttab_Child(i)) * ds_Child(i)
-C
-        dim_newmax(i) = s_Child(i) + (cetruetab(i) - 
-     &                                pttab_Child(i)) * ds_Child(i)
-C     
-        indmin(i) = pttab_Parent(i) +
-     &        agrif_ceiling((dim_newmin(i)-s_Parent(i))/ds_Parent(i))
-C
-        indmax(i) = pttab_Parent(i) +
-     &        agrif_int((dim_newmax(i)-s_Parent(i))/ds_Parent(i))
-C
-#ifdef key_mpp_mpi
-        positionmin = s_Parent(i) + (indmin(i)-
-     &                          pttab_Parent(i))*ds_Parent(i)
-        IF (loctab_Child(i) .NE. -3) THEN
-        IF (posvartab_child(i) == 1) THEN
-          IF (TypeUpdate(i) .EQ. Agrif_Update_Average) THEN
-          positionmin = positionmin - ds_Parent(i)/2.
-          ELSE IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN
-          positionmin = positionmin - (ds_Parent(i)-ds_Child(i))
-          ENDIF
-        ELSE
-          IF (TypeUpdate(i).NE.Agrif_Update_Full_Weighting) THEN
-        positionmin = positionmin - ds_Parent(i)/2.
-          ELSE
-          coeffraf = nint(ds_Parent(i)/ds_Child(i))
-          if (mod(coeffraf,2) == 1) then
-            positionmin = positionmin - (ds_Parent(i)-ds_Child(i))
-          else
-            positionmin = positionmin - (ds_Parent(i)-ds_Child(i))
-     &                                -ds_Child(i)/2.
-          endif
-        ENDIF
-        ENDIF
-        ENDIF
-        imin = pttab_Child(i) +
-     &        agrif_ceiling((positionmin-s_Child(i))/ds_Child(i))
-
-       positionmin = s_Child(i) + (imin -
-     &                             pttab_Child(i)) * ds_Child(i)
-
-        pttruetabwhole(i) = imin
-
-        positionmax = s_Parent(i) + (indmax(i)-
-     &                          pttab_Parent(i))*ds_Parent(i)
-        IF (loctab_Child(i) .NE. -3) THEN
-        IF (posvartab_child(i) == 1) THEN
-          IF (TypeUpdate(i) .EQ. Agrif_Update_Average) THEN
-        positionmax = positionmax  + ds_Parent(i)/2.
-          ELSE IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN
-          positionmax = positionmax  + (ds_Parent(i)-ds_Child(i))
-          ENDIF
-        ELSE
-          IF (TypeUpdate(i).NE.Agrif_Update_Full_Weighting) THEN        
-        positionmax = positionmax  + ds_Parent(i)/2.
-          ELSE
-          coeffraf = nint(ds_Parent(i)/ds_Child(i))
-          if (mod(coeffraf,2) == 1) then
-            positionmax = positionmax + (ds_Parent(i)-ds_Child(i))
-          else
-            positionmax = positionmax + (ds_Parent(i)-ds_Child(i)) 
-     &                                + ds_Child(i)/2.
-          endif
-
-        ENDIF        
-        ENDIF
-        ENDIF
-        imax = pttab_Child(i) +
-     &        agrif_int((positionmax-s_Child(i))/ds_Child(i))
-
-        positionmax = s_Child(i) + (imax -
-     &                                pttab_Child(i)) * ds_Child(i)
-
-        cetruetabwhole(i) = imax
-
-#endif
-C
-        s_Parent_temp(i) = s_Parent(i) + 
-     &                     (indmin(i) - pttab_Parent(i)) * 
-     &                      ds_Parent(i) 
-C     
-        s_Child_temp(i) = dim_newmin(i)
-
-#ifdef key_mpp_mpi
-        s_Child_temp(i) = positionmin
-#endif
-C
-      enddo
-C
-      Return
-C
-C
-      End Subroutine Agrif_Prtbounds
-C
-C
-C
-C
-
-C
-C
-C
-C     **************************************************************************  
-CCC   Subroutine Agrif_Update_2D_Recursive 
-C     **************************************************************************
-C
-      Subroutine Agrif_Update_2D_recursive(TypeUpdate,tempP,tempC,
-     &                                     indmin,indmax,
-     &                                     pttab_child,petab_child,
-     &                                     s_child,s_parent,
-     &                                     ds_child,ds_parent,nbdim)
-C
-CCC   Description:
-CCC   Subroutine to update a 2D grid variable on the parent grid. 
-CCC   It calls Agrif_Update_1D_Recursive and Agrif_UpdateBase.   
-C
-CC    Method:
-C
-C     Declarations:
-C
-      
-C     
-      INTEGER                   :: nbdim
-      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
-      INTEGER, DIMENSION(nbdim) :: indmin,indmax
-      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
-      REAL, DIMENSION(nbdim)    :: s_child,s_parent
-      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
-      REAL, DIMENSION(indmin(1):indmax(1),
-     &                indmin(2):indmax(2))           :: tempP
-C      REAL, DIMENSION(pttab_child(1):petab_child(1),
-C     &                pttab_child(2):petab_child(2)) :: tempC
-     
-      REAL, DIMENSION(:,:) :: tempC     
-C
-C     Local variables      
-      REAL, DIMENSION(indmin(1):indmax(1),
-     &                 pttab_child(2):petab_child(2)) :: tabtemp
-      REAL, DIMENSION(indmin(2):indmax(2),
-     &                indmin(1):indmax(1))           :: tempP_trsp
-      REAL, DIMENSION(pttab_child(2):petab_child(2),
-     &                 indmin(1):indmax(1)) :: tabtemp_trsp
-      INTEGER :: i,j
-      INTEGER :: coeffraf,locind_child_left
-C
-      tabtemp = 0.
-
-
-      coeffraf = nint ( ds_parent(1) / ds_child(1) ) 
-      IF((TypeUpdate(1) == AGRIF_Update_average) 
-     &                 .AND. (coeffraf /= 1 ))THEN
-!---CDIR NEXPAND
-         IF(.NOT. precomputedone(1) ) Call average1Dprecompute2D
-     &       (petab_child(2)-pttab_child(2)+1,
-     &        indmax(1)-indmin(1)+1,
-     &        petab_child(1)-pttab_child(1)+1,
-     &        s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
-!---CDIR NEXPAND
-          Call average1Daftercompute
-     &       (  tabtemp, tempC,
-     &          size(tabtemp), size(tempC),
-     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
- 
-      ELSEIF((TypeUpdate(1) == AGRIF_Update_copy)
-     &                 .AND. (coeffraf /= 1 ))THEN
-!---CDIR NEXPAND
-         IF(.NOT. precomputedone(1) ) Call copy1Dprecompute2D
-     &       (petab_child(2)-pttab_child(2)+1,
-     &        indmax(1)-indmin(1)+1,
-     &        petab_child(1)-pttab_child(1)+1,
-     &        s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
-!---CDIR NEXPAND
-          Call copy1Daftercompute
-     &       (  tabtemp, tempC,
-     &          size(tabtemp), size(tempC),
-     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
-
-      ELSE
-      do j = pttab_child(nbdim),petab_child(nbdim)
-C
-!---CDIR NEXPAND
-        Call Agrif_Update_1D_recursive(TypeUpdate(1:nbdim-1),    
-     &         tabtemp(:,j),
-     &         tempC(:,j-pttab_child(nbdim)+1),
-     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
-     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
-     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
-     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
-C
-      enddo
-      ENDIF
-      tabtemp_trsp = TRANSPOSE(tabtemp) 
-      coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
-    
-!---CDIR NEXPAND
-      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
-     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
-C
-      
-      tempP_trsp = 0. 
-
-      IF((TypeUpdate(2) == AGRIF_Update_average)
-     &                .AND. (coeffraf /= 1 ))THEN
-!---CDIR NEXPAND
-         IF(.NOT. precomputedone(2) ) Call average1Dprecompute2D
-     &      ( indmax(1)-indmin(1)+1,
-     &        indmax(2)-indmin(2)+1,
-     &        petab_child(2)-pttab_child(2)+1,
-     &        s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
-!---CDIR NEXPAND
-          Call average1Daftercompute
-     &       (  tempP_trsp, tabtemp_trsp,
-     &          size(tempP_trsp), size(tabtemp_trsp),
-     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
-
-      ELSEIF((TypeUpdate(2) == AGRIF_Update_copy)
-     &                .AND. (coeffraf /= 1 ))THEN
-!---CDIR NEXPAND
-         IF(.NOT. precomputedone(2) ) Call copy1Dprecompute2D
-     &      ( indmax(1)-indmin(1)+1,
-     &        indmax(2)-indmin(2)+1,
-     &        petab_child(2)-pttab_child(2)+1,
-     &        s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
-!---CDIR NEXPAND
-          Call copy1Daftercompute
-     &       (  tempP_trsp, tabtemp_trsp,
-     &          size(tempP_trsp), size(tabtemp_trsp),
-     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
-
-      ELSE
-
-      do i = indmin(1),indmax(1)
-C
-!---CDIR NEXPAND
-        Call Agrif_UpdateBase(TypeUpdate(2),
-     &           tempP_trsp(indmin(nbdim):indmax(nbdim),i),
-     &          tabtemp_trsp(pttab_child(nbdim):petab_child(nbdim),i),
-     &           indmin(nbdim),indmax(nbdim),
-     &           pttab_child(nbdim),petab_child(nbdim),
-     &           s_parent(nbdim),s_child(nbdim),
-     &           ds_parent(nbdim),ds_child(nbdim),
-     &                  coeffraf,locind_child_left)
-C        
-      enddo
-      
-      ENDIF
-
-      tempP = TRANSPOSE(tempP_trsp)
-C
-      Return
-C
-C
-      End Subroutine Agrif_Update_2D_recursive
-C
-C
-C
-C     **************************************************************************  
-CCC   Subroutine Agrif_Update_3D_Recursive 
-C     **************************************************************************
-C
-      Subroutine Agrif_Update_3D_recursive(TypeUpdate,tempP,tempC,
-     &                                     indmin,indmax,   
-     &                                     pttab_child,petab_child,
-     &                                     s_child,s_parent,
-     &                                     ds_child,ds_parent,nbdim)
-C
-CCC   Description:
-CCC   Subroutine to update a 3D grid variable on the parent grid. 
-CCC   It calls Agrif_Update_2D_Recursive and Agrif_UpdateBase.   
-C
-CC    Method:
-C
-C     Declarations:
-C
-      
-C     
-      INTEGER                   :: nbdim
-      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
-      INTEGER, DIMENSION(nbdim) :: indmin,indmax
-      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
-      REAL, DIMENSION(nbdim)    :: s_child,s_parent
-      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
-      REAL, DIMENSION(indmin(1):indmax(1),
-     &                indmin(2):indmax(2),
-     &                indmin(3):indmax(3))           :: tempP
-      REAL, DIMENSION(pttab_child(1):petab_child(1),
-     &                pttab_child(2):petab_child(2),
-     &                pttab_child(3):petab_child(3)) :: tempC
-C
-C     Local variables      
-      REAL, DIMENSION(indmin(1):indmax(1),
-     &                 indmin(2):indmax(2), 
-     &                 pttab_child(3):petab_child(3)) :: tabtemp
-      INTEGER :: i,j,k
-      INTEGER :: coeffraf,locind_child_left
-      INTEGER :: kdeb
-C
-C
-      coeffraf = nint ( ds_parent(1) / ds_child(1) )
-      IF((TypeUpdate(1) == AGRIF_Update_average)
-     &                 .AND. (coeffraf /= 1 ))THEN
-!---CDIR NEXPAND
-         Call average1Dprecompute2D
-     &       (petab_child(2)-pttab_child(2)+1,
-     &        indmax(1)-indmin(1)+1,
-     &        petab_child(1)-pttab_child(1)+1,
-     &        s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
-      precomputedone(1) = .TRUE.
-      ELSEIF((TypeUpdate(1) == AGRIF_Update_copy)
-     &                 .AND. (coeffraf /= 1 ))THEN
-!---CDIR NEXPAND
-         Call copy1Dprecompute2D
-     &       (petab_child(2)-pttab_child(2)+1,
-     &        indmax(1)-indmin(1)+1,
-     &        petab_child(1)-pttab_child(1)+1,
-     &        s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
-      precomputedone(1) = .TRUE.
-      ENDIF
-
-      coeffraf = nint ( ds_parent(2) / ds_child(2) )
-      IF((TypeUpdate(2) == AGRIF_Update_average)
-     &                .AND. (coeffraf /= 1 ))THEN
-!---CDIR NEXPAND
-         Call average1Dprecompute2D
-     &      ( indmax(1)-indmin(1)+1,
-     &        indmax(2)-indmin(2)+1,
-     &        petab_child(2)-pttab_child(2)+1,
-     &        s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
-      precomputedone(2) = .TRUE.
-      ELSEIF((TypeUpdate(2) == AGRIF_Update_copy)
-     &                .AND. (coeffraf /= 1 ))THEN
-!---CDIR NEXPAND
-         Call copy1Dprecompute2D
-     &      ( indmax(1)-indmin(1)+1,
-     &        indmax(2)-indmin(2)+1,
-     &        petab_child(2)-pttab_child(2)+1,
-     &        s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
-      precomputedone(2) = .TRUE.
-      ENDIF
-
-
-      do k = pttab_child(nbdim),petab_child(nbdim)
-C
-        Call Agrif_Update_2D_recursive(TypeUpdate(1:nbdim-1),    
-     &         tabtemp(:,:,k),
-     &         tempC(:,:,k),
-     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
-     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
-     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
-     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
-C
-      enddo
-C
-      precomputedone(1) = .FALSE.
-      precomputedone(2) = .FALSE.
-      coeffraf = nint ( ds_parent(3) / ds_child(3) )
-
-      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
-     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
-      
-      IF (coeffraf == 1) THEN
-      
-      kdeb = pttab_child(3)+locind_child_left-2
-      do k=indmin(3),indmax(3)
-      kdeb = kdeb + 1
-      do j = indmin(2),indmax(2)
-        do i = indmin(1),indmax(1)
-        tempP(i,j,k) = tabtemp(i,j,kdeb)
-      enddo
-      enddo
-      enddo
-              
-      ELSE
-      tempP = 0.
-C
-      do j = indmin(2),indmax(2)
-C
-        do i = indmin(1),indmax(1)
-C
-          Call Agrif_UpdateBase(TypeUpdate(3),
-     &           tempP(i,j,:),
-     &          tabtemp(i,j,:),
-     &           indmin(nbdim),indmax(nbdim),
-     &           pttab_child(nbdim),petab_child(nbdim),
-     &           s_parent(nbdim),s_child(nbdim),
-     &           ds_parent(nbdim),ds_child(nbdim),
-     &                  coeffraf,locind_child_left)
-C
-        enddo 
-C        
-      enddo
-      ENDIF
-C
-      Return
-C
-C
-      End Subroutine Agrif_Update_3D_recursive
-C
-C
-C
-C     **************************************************************************  
-CCC   Subroutine Agrif_Update_4D_Recursive 
-C     **************************************************************************
-C
-      Subroutine Agrif_Update_4D_recursive(TypeUpdate,tempP,tempC,
-     &                                     indmin,indmax,   
-     &                                     pttab_child,petab_child,
-     &                                     s_child,s_parent,
-     &                                     ds_child,ds_parent,nbdim)
-C
-CCC   Description:
-CCC   Subroutine to update a 4D grid variable on the parent grid. 
-CCC   It calls Agrif_Update_3D_Recursive and Agrif_UpdateBase.    
-C
-CC    Method:
-C
-C     Declarations:
-C
-      
-C     
-      INTEGER                   :: nbdim
-      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
-      INTEGER, DIMENSION(nbdim) :: indmin,indmax
-      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
-      REAL, DIMENSION(nbdim)    :: s_child,s_parent
-      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
-      REAL, DIMENSION(indmin(1):indmax(1),
-     &                indmin(2):indmax(2),
-     &                indmin(3):indmax(3),
-     &                indmin(4):indmax(4))           :: tempP
-      REAL, DIMENSION(pttab_child(1):petab_child(1),
-     &                pttab_child(2):petab_child(2),
-     &                pttab_child(3):petab_child(3),
-     &                pttab_child(4):petab_child(4)) :: tempC
-C
-C     Local variables      
-      REAL, DIMENSION(:,:,:,:), Allocatable :: tabtemp
-      INTEGER :: i,j,k,l
-      INTEGER :: coeffraf,locind_child_left
-C
-C
-      Allocate(tabtemp(indmin(1):indmax(1),
-     &                 indmin(2):indmax(2),
-     &                 indmin(3):indmax(3), 
-     &                 pttab_child(4):petab_child(4)))
-C
-      do l = pttab_child(nbdim),petab_child(nbdim)
-C
-        Call Agrif_Update_3D_recursive(TypeUpdate(1:nbdim-1),    
-     &         tabtemp(indmin(nbdim-3):indmax(nbdim-3),
-     &                 indmin(nbdim-2):indmax(nbdim-2),
-     &                 indmin(nbdim-1):indmax(nbdim-1),l),
-     &         tempC(pttab_child(nbdim-3):petab_child(nbdim-3),
-     &               pttab_child(nbdim-2):petab_child(nbdim-2),
-     &               pttab_child(nbdim-1):petab_child(nbdim-1),l),
-     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
-     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
-     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
-     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
-C
-      enddo
-      
-      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
-     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
-C
-      tempP = 0.
-
-      do k = indmin(3),indmax(3)
-C
-        do j = indmin(2),indmax(2)
-C
-          do i = indmin(1),indmax(1)
-C
-            Call Agrif_UpdateBase(TypeUpdate(4),
-     &           tempP(i,j,k,indmin(nbdim):indmax(nbdim)),
-     &          tabtemp(i,j,k,pttab_child(nbdim):petab_child(nbdim)),
-     &           indmin(nbdim),indmax(nbdim),
-     &           pttab_child(nbdim),petab_child(nbdim),
-     &           s_parent(nbdim),s_child(nbdim),
-     &           ds_parent(nbdim),ds_child(nbdim),
-     &                  coeffraf,locind_child_left)
-C
-          enddo 
-C
-        enddo 
-C        
-      enddo
-C
-      Deallocate(tabtemp)
-C
-      Return
-C
-C
-      End Subroutine Agrif_Update_4D_recursive
-C
-C
-C
-C     **************************************************************************  
-CCC   Subroutine Agrif_Update_5D_Recursive 
-C     **************************************************************************
-C
-      Subroutine Agrif_Update_5D_recursive(TypeUpdate,tempP,tempC,
-     &                                     indmin,indmax,   
-     &                                     pttab_child,petab_child,
-     &                                     s_child,s_parent,
-     &                                     ds_child,ds_parent,nbdim)
-C
-CCC   Description:
-CCC   Subroutine to update a 5D grid variable on the parent grid. 
-CCC   It calls Agrif_Update_4D_Recursive and Agrif_UpdateBase.    
-C
-CC    Method:
-C
-C     Declarations:
-C
-      
-C     
-      INTEGER                   :: nbdim
-      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
-      INTEGER, DIMENSION(nbdim) :: indmin,indmax
-      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
-      REAL, DIMENSION(nbdim)    :: s_child,s_parent
-      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
-      REAL, DIMENSION(indmin(1):indmax(1),
-     &                indmin(2):indmax(2),
-     &                indmin(3):indmax(3),
-     &                indmin(4):indmax(4),
-     &                indmin(5):indmax(5))           :: tempP
-      REAL, DIMENSION(pttab_child(1):petab_child(1),
-     &                pttab_child(2):petab_child(2),
-     &                pttab_child(3):petab_child(3),
-     &                pttab_child(4):petab_child(4),
-     &                pttab_child(5):petab_child(5)) :: tempC
-C
-C     Local variables      
-      REAL, DIMENSION(:,:,:,:,:), Allocatable :: tabtemp
-      INTEGER :: i,j,k,l,m
-      INTEGER :: coeffraf,locind_child_left
-C
-C
-      Allocate(tabtemp(indmin(1):indmax(1),
-     &                 indmin(2):indmax(2),
-     &                 indmin(3):indmax(3),
-     &                 indmin(4):indmax(4),   
-     &                 pttab_child(5):petab_child(5)))
-C
-      do m = pttab_child(nbdim),petab_child(nbdim)
-C
-        Call Agrif_Update_4D_recursive(TypeUpdate(1:nbdim-1),    
-     &         tabtemp(indmin(nbdim-4):indmax(nbdim-4),
-     &                 indmin(nbdim-3):indmax(nbdim-3),
-     &                 indmin(nbdim-2):indmax(nbdim-2),
-     &                 indmin(nbdim-1):indmax(nbdim-1),m),
-     &         tempC(pttab_child(nbdim-4):petab_child(nbdim-4),
-     &               pttab_child(nbdim-3):petab_child(nbdim-3),
-     &               pttab_child(nbdim-2):petab_child(nbdim-2),
-     &               pttab_child(nbdim-1):petab_child(nbdim-1),m),
-     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
-     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
-     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
-     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
-C
-      enddo
-      
-      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
-     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
-      tempP = 0.
-C
-      do l = indmin(4),indmax(4)
-C
-        do k = indmin(3),indmax(3)
-C
-          do j = indmin(2),indmax(2)
-C
-            do i = indmin(1),indmax(1)
-C
-              Call Agrif_UpdateBase(TypeUpdate(5),
-     &           tempP(i,j,k,l,indmin(nbdim):indmax(nbdim)),
-     &          tabtemp(i,j,k,l,
-     &                   pttab_child(nbdim):petab_child(nbdim)),
-     &           indmin(nbdim),indmax(nbdim),
-     &           pttab_child(nbdim),petab_child(nbdim),
-     &           s_parent(nbdim),s_child(nbdim),
-     &           ds_parent(nbdim),ds_child(nbdim),
-     &                  coeffraf,locind_child_left)
-C
-            enddo
-C
-          enddo 
-C
-        enddo 
-C        
-      enddo
-C
-      Deallocate(tabtemp)
-C
-      Return
-C
-C
-      End Subroutine Agrif_Update_5D_recursive
-C
-C
-C
-C
-C     **************************************************************************  
-CCC   Subroutine Agrif_Update_6D_Recursive 
-C     **************************************************************************
-C
-      Subroutine Agrif_Update_6D_recursive(TypeUpdate,tempP,tempC,
-     &                                     indmin,indmax,   
-     &                                     pttab_child,petab_child,
-     &                                     s_child,s_parent,
-     &                                     ds_child,ds_parent,nbdim)
-C
-CCC   Description:
-CCC   Subroutine to update a 6D grid variable on the parent grid. 
-CCC   It calls Agrif_Update_5D_Recursive and Agrif_UpdateBase.    
-C
-CC    Method:
-C
-C     Declarations:
-C
-      
-C     
-      INTEGER                   :: nbdim
-      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
-      INTEGER, DIMENSION(nbdim) :: indmin,indmax
-      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
-      REAL, DIMENSION(nbdim)    :: s_child,s_parent
-      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
-      REAL, DIMENSION(indmin(1):indmax(1),
-     &                indmin(2):indmax(2),
-     &                indmin(3):indmax(3),
-     &                indmin(4):indmax(4),
-     &                indmin(5):indmax(5),
-     &                indmin(6):indmax(6))           :: tempP
-      REAL, DIMENSION(pttab_child(1):petab_child(1),
-     &                pttab_child(2):petab_child(2),
-     &                pttab_child(3):petab_child(3),
-     &                pttab_child(4):petab_child(4),
-     &                pttab_child(5):petab_child(5),
-     &                pttab_child(6):petab_child(6)) :: tempC
-C
-C     Local variables      
-      REAL, DIMENSION(:,:,:,:,:,:), Allocatable :: tabtemp
-      INTEGER :: i,j,k,l,m,n
-      INTEGER :: coeffraf,locind_child_left
-C
-C
-      Allocate(tabtemp(indmin(1):indmax(1),
-     &                 indmin(2):indmax(2),
-     &                 indmin(3):indmax(3),
-     &                 indmin(4):indmax(4),   
-     &                 indmin(5):indmax(5),   
-     &                 pttab_child(6):petab_child(6)))
-C
-      do n = pttab_child(nbdim),petab_child(nbdim)
-C
-        Call Agrif_Update_5D_recursive(TypeUpdate(1:nbdim-1),    
-     &         tabtemp(indmin(nbdim-5):indmax(nbdim-5),
-     &                 indmin(nbdim-4):indmax(nbdim-4),
-     &                 indmin(nbdim-3):indmax(nbdim-3),
-     &                 indmin(nbdim-2):indmax(nbdim-2),
-     &                 indmin(nbdim-1):indmax(nbdim-1),n),
-     &         tempC(pttab_child(nbdim-5):petab_child(nbdim-5),
-     &               pttab_child(nbdim-4):petab_child(nbdim-4),
-     &               pttab_child(nbdim-3):petab_child(nbdim-3),
-     &               pttab_child(nbdim-2):petab_child(nbdim-2),
-     &               pttab_child(nbdim-1):petab_child(nbdim-1),n),
-     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
-     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
-     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
-     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
-C
-      enddo
-      
-      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
-     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
-C
-      tempP = 0.
-
-      do m = indmin(5),indmax(5)
-      do l = indmin(4),indmax(4)
-C
-        do k = indmin(3),indmax(3)
-C
-          do j = indmin(2),indmax(2)
-C
-            do i = indmin(1),indmax(1)
-C
-              Call Agrif_UpdateBase(TypeUpdate(6),
-     &           tempP(i,j,k,l,m,indmin(nbdim):indmax(nbdim)),
-     &          tabtemp(i,j,k,l,m,
-     &                   pttab_child(nbdim):petab_child(nbdim)),
-     &           indmin(nbdim),indmax(nbdim),
-     &           pttab_child(nbdim),petab_child(nbdim),
-     &           s_parent(nbdim),s_child(nbdim),
-     &           ds_parent(nbdim),ds_child(nbdim),
-     &                  coeffraf,locind_child_left)
-C
-            enddo
-C
-          enddo 
-C
-        enddo 
-C        
-      enddo
-      enddo
-C
-      Deallocate(tabtemp)
-C
-      Return
-C
-C
-      End Subroutine Agrif_Update_6D_recursive
-C
-C
-C
-C     **************************************************************************  
-CCC   Subroutine Agrif_UpdateBase  
-C     **************************************************************************  
-C  
-      Subroutine Agrif_UpdateBase(TypeUpdate,
-     &                            parenttab,childtab,
-     &                            indmin,indmax,pttab_child,petab_child,
-     &                            s_parent,s_child,ds_parent,ds_child,
-     &                            coeffraf,locind_child_left)
-C
-CCC   Description:
-CCC   Subroutine calling the updating method chosen by the user (copy, average
-CCC   or full-weighting).    
-C
-CC    Method:
-C
-C     Declarations:
-C
-      
-C
-      INTEGER :: TypeUpdate
-      INTEGER :: indmin,indmax
-      INTEGER :: pttab_child,petab_child
-      REAL,DIMENSION(indmin:indmax)           :: parenttab       
-      REAL,DIMENSION(pttab_child:petab_child) :: childtab      
-      REAL    :: s_parent,s_child
-      REAL    :: ds_parent,ds_child      
-      INTEGER :: coeffraf,locind_child_left
-C
-C
-      if (TypeUpdate == AGRIF_Update_copy) then
-C             
-          Call agrif_copy1D
-     &       (parenttab,childtab,
-     &          indmax-indmin+1,petab_child-pttab_child+1,
-     &          s_parent,s_child,ds_parent,ds_child)     
-C
-        elseif (TypeUpdate == AGRIF_Update_average) then
-C           
-          Call average1D
-     &       (parenttab,childtab,
-     &          indmax-indmin+1,petab_child-pttab_child+1,
-     &          s_parent,s_child,ds_parent,ds_child) 
-C
-        elseif (TypeUpdate == AGRIF_Update_full_weighting) then
-C             
-          Call full_weighting1D
-     &       (parenttab,childtab,
-     &          indmax-indmin+1,petab_child-pttab_child+1,
-     &          s_parent,s_child,ds_parent,ds_child,
-     &          coeffraf,locind_child_left)
-C
-      endif 
-C
-      Return                
-C
-C      
-      End Subroutine Agrif_UpdateBase
-C
-C
-
-      Subroutine Agrif_Compute_nbdim_update(s_parent,s_child,
-     &  ds_parent,ds_child,coeffraf,locind_child_left)
-      real :: s_parent,s_child,ds_parent,ds_child
-      integer :: coeffraf,locind_child_left
-     
-      coeffraf = nint(ds_parent/ds_child)
-      locind_child_left = 1 + agrif_int((s_parent-s_child)/ds_child)
-      
-      End Subroutine Agrif_Compute_nbdim_update
- 
-#if defined key_mpp_mpi      
-      Subroutine Agrif_Find_list_update(list_update,pttab,petab,
-     &                          pttab_Child,pttab_Parent,nbdim,
-     &     find_list_update,tab4t,tab5t,memberinall,memberinall2,
-     &     sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2)     
-      TYPE(Agrif_List_Interp_Loc), Pointer :: list_update
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(nbdim)   :: pttab,petab,pttab_Child,pttab_Parent
-      LOGICAL :: find_list_update
-      Type(Agrif_List_Interp_loc), Pointer :: parcours
-      INTEGER :: i
-C
-      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
-      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab5t      
-      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall,memberinall2
-      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1      
-      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc2,recvfromproc2      
-                    
-      find_list_update = .FALSE.
-      
-      parcours => list_update
-      
-      Find_loop :   Do While (associated(parcours))
-        Do i=1,nbdim
-          IF ((pttab(i) /= parcours%interp_loc%pttab(i)).OR.
-     &        (petab(i) /= parcours%interp_loc%petab(i)).OR.
-     &        (pttab_child(i) /= parcours%interp_loc%pttab_child(i)).OR.
-     &        (pttab_parent(i) /= parcours%interp_loc%pttab_parent(i)))
-     &               THEN
-            parcours=>parcours%suiv
-            Cycle Find_loop
-          ENDIF
-        EndDo
-        
-        tab4t = parcours%interp_loc%tab4t(1:nbdim,0:Agrif_Nbprocs-1,1:8)
-        memberinall = parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1)
-        
-        tab5t = parcours%interp_loc%tab5t(1:nbdim,0:Agrif_Nbprocs-1,1:8)
-        memberinall2 = 
-     &       parcours%interp_loc%memberinall2(0:Agrif_Nbprocs-1)
-        sendtoproc1 = 
-     &       parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1)   
-        recvfromproc1 = 
-     &       parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1)     
-        sendtoproc2 = 
-     &       parcours%interp_loc%sendtoproc2(0:Agrif_Nbprocs-1)   
-        recvfromproc2 = 
-     &       parcours%interp_loc%recvfromproc2(0:Agrif_Nbprocs-1)          
-        
-        find_list_update = .TRUE.   
-        Exit Find_loop
-      End Do Find_loop  
-                              
-      End Subroutine Agrif_Find_list_update  
-      
-      Subroutine Agrif_AddTo_list_update(list_update,pttab,petab,
-     &                          pttab_Child,pttab_Parent,nbdim
-     &      ,tab4t,tab5t,memberinall,memberinall2,
-     &      sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2)
-          
-      TYPE(Agrif_List_Interp_Loc), Pointer :: list_update
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(nbdim)   :: pttab,petab,pttab_Child,pttab_Parent
-      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
-      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab5t      
-      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: memberinall, memberinall2
-      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1, recvfromproc1      
-      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc2, recvfromproc2
-
-      Type(Agrif_List_Interp_loc), Pointer :: parcours
-            
-       Allocate(parcours)
-      Allocate(parcours%interp_loc)
-      
-      parcours%interp_loc%pttab(1:nbdim) = pttab(1:nbdim)
-      parcours%interp_loc%petab(1:nbdim) = petab(1:nbdim)
-      parcours%interp_loc%pttab_child(1:nbdim) = pttab_child(1:nbdim)
-      parcours%interp_loc%pttab_parent(1:nbdim) = pttab_parent(1:nbdim)
-      Allocate(parcours%interp_loc%tab4t(nbdim,0:Agrif_Nbprocs-1,8))
-      Allocate(parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1))
-      
-      Allocate(parcours%interp_loc%tab5t(nbdim,0:Agrif_Nbprocs-1,8))
-      Allocate(parcours%interp_loc%memberinall2(0:Agrif_Nbprocs-1))
-      Allocate(parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1))
-      Allocate(parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1))      
-      Allocate(parcours%interp_loc%sendtoproc2(0:Agrif_Nbprocs-1))
-      Allocate(parcours%interp_loc%recvfromproc2(0:Agrif_Nbprocs-1))            
-            
-      parcours%interp_loc%tab4t=tab4t   
-      parcours%interp_loc%memberinall=memberinall
- 
-      parcours%interp_loc%tab5t=tab5t   
-      parcours%interp_loc%memberinall2=memberinall2
-      parcours%interp_loc%sendtoproc1=sendtoproc1   
-      parcours%interp_loc%recvfromproc1=recvfromproc1      
-      parcours%interp_loc%sendtoproc2=sendtoproc2       
-      parcours%interp_loc%recvfromproc2=recvfromproc2      
-            
-      parcours%suiv => list_update
-      
-      list_update => parcours
-      
-      End Subroutine Agrif_Addto_list_update
-#endif
-           
-
-C     **************************************************************************
-CCC   Subroutine Agrif_Update_1D_Recursive
-C     **************************************************************************
-C
-      Subroutine Agrif_Update_1D_recursive(TypeUpdate,tempP,tempC,
-     &                                     indmin,indmax,
-     &                                     pttab_child,petab_child,
-     &                                     s_child,s_parent,
-     &                                     ds_child,ds_parent,nbdim)
-C
-CCC   Description:
-CCC   Subroutine to update a 1D grid variable on the parent grid.
-C
-CC    Method:
-C
-C     Declarations:
-C
-      
-C
-C     Arguments
-      INTEGER                   :: nbdim
-      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
-      INTEGER, DIMENSION(nbdim) :: indmin,indmax
-      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
-      REAL, DIMENSION(nbdim)    :: s_child,s_parent
-      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
-      REAL, DIMENSION(indmin(nbdim):indmax(nbdim))           :: tempP
-      REAL, DIMENSION(pttab_child(nbdim):petab_child(nbdim)) :: tempC
-      INTEGER :: coeffraf,locind_child_left
-C
-C
-      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
-     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
-      
-      Call Agrif_UpdateBase(TypeUpdate(1),
-     &                  tempP(indmin(nbdim):indmax(nbdim)),
-     &                  tempC(pttab_child(nbdim):petab_child(nbdim)),
-     &                  indmin(nbdim),indmax(nbdim),           
-     &                  pttab_child(nbdim),petab_child(nbdim),
-     &                  s_parent(nbdim),s_child(nbdim),
-     &                  ds_parent(nbdim),ds_child(nbdim),
-     &                  coeffraf,locind_child_left)
-
-C
-      Return
-C
-C
-      End Subroutine Agrif_Update_1D_recursive      
-
-      End Module Agrif_Update
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F90	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F90	(revision 6440)
@@ -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: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdatebasic.F
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdatebasic.F	(revision 6439)
+++ 	(revision )
@@ -1,659 +1,0 @@
-!
-! $Id: modupdatebasic.F 2715 2011-03-30 15:58:35Z rblod $
-!
-C     AGRIF (Adaptive Grid Refinement In Fortran)
-C
-C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
-C
-C     This program is free software; you can redistribute it and/or modify
-C     it under the terms of the GNU General Public License as published by
-C     the Free Software Foundation; either version 2 of the License, or
-C     (at your option) any later version.
-C
-C     This program is distributed in the hope that it will be useful,
-C     but WITHOUT ANY WARRANTY; without even the implied warranty of
-C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-C     GNU General Public License for more details.
-C
-C     You should have received a copy of the GNU General Public License
-C     along with this program; if not, write to the Free Software
-C     Foundation, Inc., 59 Temple Place -  Suite 330, Boston, MA 02111-1307, USA.
-C
-C
-C
-CCC   Module Agrif_Updatebasic
-C      
-C
-      Module Agrif_Updatebasic
-C
-CCC   Description:
-CCC   Module containing different procedures of update (copy,average,
-CCC   full_weighting) used in the Agrif_Update module.
-C
-C     Modules used:
-C
-      USE Agrif_types
-      
-      IMPLICIT NONE
-      
-      integer,dimension(:,:),allocatable :: indchildcopy
-      integer,dimension(:,:),allocatable :: indchildaverage
-C             
-
-      CONTAINS
-C     Define procedures contained in this module
-C
-C
-C
-C     **************************************************************************  
-CCC   Subroutine Copy1d  
-C     ************************************************************************** 
-C
-      Subroutine agrif_copy1d(x,y,np,nc,
-     &                  s_parent,s_child,ds_parent,ds_child) 
-C
-CCC   Description:
-CCC   Subroutine to do a copy on a parent grid (vector x) from its child grid 
-CCC   (vector y).  
-C
-CC    Method:
-C
-C     Declarations:
-C
-      
-C        
-C     Arguments
-      INTEGER             :: np,nc      
-      REAL, DIMENSION(np) :: x      
-      REAL, DIMENSION(nc) :: y  
-      REAL                :: s_parent,s_child
-      REAL                :: ds_parent,ds_child
-C
-C     Local variables
-      INTEGER :: i,locind_child_left,coeffraf
-C 
-C
-      coeffraf = nint(ds_parent/ds_child)
-C
-      if (coeffraf == 1) then
-C
-          locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
-C        
-!CDIR ALTCODE
-          x(1:np) = y(locind_child_left:locind_child_left+np-1)
-C
-          return
-C
-      endif
-C
-      
-      locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
-      
-!CDIR ALTCODE
-      do i = 1,np
-C      
-         x(i) = y(locind_child_left)
-C
-         locind_child_left = locind_child_left + coeffraf
-C         
-      enddo    
-       
-C
-      Return 
-C
-C
-      End Subroutine agrif_copy1d
-
-C     **************************************************************************  
-CCC   Subroutine Copy1dprecompute  
-C     ************************************************************************** 
-C
-      Subroutine copy1dprecompute2d(nc2,np,nc,
-     &                  s_parent,s_child,ds_parent,ds_child,dir)
-C
-CCC   Description:
-CCC   Subroutine to precompute index for a copy on a parent grid (vector x) from
-CCC   its child grid (vector y).
-C
-CC    Method:
-C
-C     Declarations:
-C
-
-C        
-C     Arguments
-      INTEGER             :: nc2,np,nc
-      INTEGER             :: dir   
-      REAL                :: s_parent,s_child
-      REAL                :: ds_parent,ds_child
-C
-C     Local variables
-      INTEGER,DIMENSION(:,:),ALLOCATABLE :: indchildcopy_tmp
-      INTEGER :: i,locind_child_left,coeffraf
-C 
-C
-      coeffraf = nint(ds_parent/ds_child)
-C
-      locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
-
-      if (.not.allocated(indchildcopy)) then
-      allocate(indchildcopy(np*nc2,3))
-      else
-      if (size(indchildcopy,1)<np*nc2) then
-      allocate( indchildcopy_tmp(
-     &         size(indchildcopy,1),size(indchildcopy,2)))
-      indchildcopy_tmp = indchildcopy
-      deallocate(indchildcopy)
-      allocate(indchildcopy(np*nc2,3))
-      indchildcopy(1:size(indchildcopy_tmp,1),
-     &              1:size(indchildcopy_tmp,2)) = indchildcopy_tmp
-      deallocate(indchildcopy_tmp)
-      endif
-      endif
-
-
-      do i = 1,np
-C      
-         indchildcopy(i,dir) = locind_child_left
-         locind_child_left = locind_child_left + coeffraf
-C         
-      enddo
-
-      do i =2, nc2
-        indchildcopy(1+(i-1)*np:i*np,dir)=
-     &       indchildcopy(1+(i-2)*np:(i-1)*np,dir) + nc 
-      enddo
-
-C
-      Return
-C
-C
-      End Subroutine copy1dprecompute2d
-
-C
-C
-C     **************************************************************************  
-CCC   Subroutine Copy1dprecompute  
-C     ************************************************************************** 
-C
-      Subroutine copy1dprecompute(np,nc,
-     &                  s_parent,s_child,ds_parent,ds_child,dir)
-C
-CCC   Description:
-CCC   Subroutine to precompute index for a copy on a parent grid (vector x) from
-CCC   its child grid (vector y).
-C
-CC    Method:
-C
-C     Declarations:
-C
-
-C        
-C     Arguments
-      INTEGER             :: np,nc
-      INTEGER             :: dir
-      REAL                :: s_parent,s_child
-      REAL                :: ds_parent,ds_child
-C
-C     Local variables
-      INTEGER :: i,locind_child_left,coeffraf
-C 
-C
-      coeffraf = nint(ds_parent/ds_child)
-C
-      locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
-
-      if (.not.allocated(indchildcopy)) then
-      allocate(indchildcopy(np,1))
-      else
-      if (size(indchildcopy)<np) then
-      deallocate(indchildcopy)
-      allocate(indchildcopy(np,1))
-      endif
-      endif
-
-!CDIR ALTCODE
-      do i = 1,np
-C      
-         indchildcopy(i,1) = locind_child_left
-         locind_child_left = locind_child_left + coeffraf
-C         
-      enddo
-
-C
-      Return
-C
-C
-      End Subroutine copy1dprecompute
-C
-C
-C     **************************************************************************  
-CCC   Subroutine Copy1daftercompute  
-C     ************************************************************************** 
-C
-      Subroutine copy1daftercompute(x,y,np,nc,
-     &                  s_parent,s_child,ds_parent,ds_child,dir)
-C
-CCC   Description:
-CCC   Subroutine to do a copy on a parent grid (vector x) from its child grid 
-CCC   (vector y) using precomputed index.  
-C
-CC    Method:
-C
-C     Declarations:
-C
-  
-C        
-C     Arguments
-      INTEGER             :: np,nc
-      INTEGER             :: dir
-      REAL, DIMENSION(np) :: x
-      REAL, DIMENSION(nc) :: y
-      REAL                :: s_parent,s_child
-      REAL                :: ds_parent,ds_child
-C
-C     Local variables
-      INTEGER :: i
-C 
-C
-      
-!CDIR ALTCODE
-      do i = 1,np
-C      
-         x(i) = y(indchildcopy(i,dir))
-C
-      enddo
-  
-C
-      Return
-C
-C
-      End Subroutine copy1daftercompute
-
-
-C
-C     **************************************************************************  
-CCC   Subroutine Average1d  
-C     ************************************************************************** 
-C   
-      Subroutine average1d(x,y,np,nc,
-     &                     s_parent,s_child,ds_parent,ds_child) 
-C
-CCC   Description:
-CCC   Subroutine to do an update by average on a parent grid (vector x)from its 
-CCC   child grid (vector y).
-C
-C     Arguments
-      INTEGER             :: np,nc      
-      REAL, DIMENSION(np) :: x      
-      REAL, DIMENSION(nc) :: y  
-      REAL                :: s_parent,s_child
-      REAL                :: ds_parent,ds_child
-C
-C     Local variables
-      INTEGER :: i,locind_child_left,coeffraf,ii
-      REAL    :: xpos, invcoeffraf 
-      INTEGER :: nbnonnuls
-      INTEGER :: diffmod
-C 
-C
-      coeffraf = nint(ds_parent/ds_child)
-      invcoeffraf = 1./coeffraf
-C
-      if (coeffraf == 1) then
-C
-          locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
-C        
-          x(1:np) = y(locind_child_left:locind_child_left+np-1)
-C
-          return
-C
-      endif
-C
-      xpos = s_parent      
-      
-      x = 0.
-C
-      diffmod = 0
-      
-      IF ( mod(coeffraf,2) == 0 ) diffmod = 1
-
-        locind_child_left = 1 + agrif_int((xpos - s_child)/ds_child)
-C
-      IF (Agrif_UseSpecialValueInUpdate) THEN
-
-      do i = 1,np
-          nbnonnuls = 0
-!CDIR NOVECTOR
-          Do ii = -coeffraf/2+locind_child_left+diffmod,
-     &                coeffraf/2+locind_child_left
-C 
-               IF (y(ii) .NE. Agrif_SpecialValueFineGrid) THEN
-               nbnonnuls = nbnonnuls + 1
-               x(i) = x(i) + y(ii)
-               ENDIF
-          End Do
-               IF (nbnonnuls .NE. 0) THEN
-                  x(i) = x(i)/nbnonnuls
-               ELSE
-                  x(i) = Agrif_SpecialValueFineGrid
-               ENDIF
-        locind_child_left = locind_child_left + coeffraf
-      enddo
-
-      ELSE 
-
-!CDIR ALTCODE
-      do i = 1,np
-!CDIR NOVECTOR
-          Do ii = -coeffraf/2+locind_child_left+diffmod,
-     &                coeffraf/2+locind_child_left
-C 
-               x(i) = x(i) + y(ii)
-          End Do
-                 x(i) = x(i)*invcoeffraf
-        locind_child_left = locind_child_left + coeffraf
-      enddo
-
-      ENDIF
-
-      Return 
-C            
-C     
-      End Subroutine average1d
-      
-      Subroutine average1dprecompute2d(nc2,np,nc,
-     &                     s_parent,s_child,ds_parent,ds_child,dir)
-C
-CCC   Description:
-CCC   Subroutine to do an update by average on a parent grid (vector x)from its 
-CCC   child grid (vector y).
-C
-C     Arguments
-      INTEGER             :: nc2,np,nc,dir
-      REAL                :: s_parent,s_child
-      REAL                :: ds_parent,ds_child
-C
-C     Local variables
-      INTEGER :: i,locind_child_left,coeffraf,ii
-      INTEGER,DIMENSION(:,:),ALLOCATABLE :: indchildaverage_tmp
-      REAL    :: xpos, invcoeffraf
-      INTEGER :: nbnonnuls
-      INTEGER :: diffmod
-C 
-C
-      coeffraf = nint(ds_parent/ds_child)
-C
-      xpos = s_parent
-C
-      diffmod = 0
-
-      IF ( mod(coeffraf,2) == 0 ) diffmod = 1
-
-      locind_child_left = 1 + agrif_int((xpos - s_child)/ds_child)
-
-      if (.not.allocated(indchildaverage)) then
-      allocate(indchildaverage(np*nc2,3))
-      else
-      if (size(indchildaverage,1)<np*nc2) then
-      allocate( indchildaverage_tmp(
-     &         size(indchildaverage,1),size(indchildaverage,2)))
-      indchildaverage_tmp = indchildaverage
-      deallocate(indchildaverage)
-      allocate(indchildaverage(np*nc2,3))
-      indchildaverage(1:size(indchildaverage_tmp,1),
-     &              1:size(indchildaverage_tmp,2)) = indchildaverage_tmp
-      deallocate(indchildaverage_tmp)
-      endif
-      endif
-
-      do i = 1,np
-        indchildaverage(i,dir)= -coeffraf/2+locind_child_left
-     &                                    +diffmod
-        locind_child_left = locind_child_left + coeffraf
-      enddo
-      do i = 2,nc2
-        indchildaverage(1+(i-1)*np:i*np,dir)= 
-     &                 indchildaverage(1+(i-2)*np:(i-1)*np,dir) + nc 
-      enddo
-
-      Return 
-C            
-C     
-      End Subroutine average1dprecompute2d
-      
-
-      Subroutine average1dprecompute(np,nc,
-     &                     s_parent,s_child,ds_parent,ds_child) 
-C
-CCC   Description:
-CCC   Subroutine to do an update by average on a parent grid (vector x)from its 
-CCC   child grid (vector y).
-C
-C     Arguments
-      INTEGER             :: np,nc 
-      REAL                :: s_parent,s_child
-      REAL                :: ds_parent,ds_child
-C
-C     Local variables
-      INTEGER :: i,locind_child_left,coeffraf,ii
-      REAL    :: xpos, invcoeffraf 
-      INTEGER :: nbnonnuls
-      INTEGER :: diffmod
-C 
-C
-      coeffraf = nint(ds_parent/ds_child)
-
-C
-      if (coeffraf == 1) then
-C
-          return
-C
-      endif
-            
-C
-      xpos = s_parent
-C
-      diffmod = 0
-      
-      IF ( mod(coeffraf,2) == 0 ) diffmod = 1
-
-        locind_child_left = 1 + agrif_int((xpos - s_child)/ds_child)
-
-      if (.not.allocated(indchildaverage)) then
-      allocate(indchildaverage(np,1))
-      else
-      if (size(indchildaverage,1)<np) then
-      deallocate(indchildaverage)
-      allocate(indchildaverage(np,1))
-      endif
-      endif
-      
-!CDIR ALTCODE
-      do i = 1,np
-C 
-        indchildaverage(i,1)=-coeffraf/2+locind_child_left+diffmod
-        locind_child_left = locind_child_left + coeffraf
-      enddo
-
-      Return 
-C            
-C     
-      End Subroutine average1dprecompute
-      
-      Subroutine average1daftercompute(x,y,np,nc,
-     &                     s_parent,s_child,ds_parent,ds_child,dir) 
-C
-CCC   Description:
-CCC   Subroutine to do an update by average on a parent grid (vector x)from its 
-CCC   child grid (vector y).
-C
-C     Arguments
-      INTEGER             :: np,nc,dir      
-      REAL, DIMENSION(np) :: x      
-      REAL, DIMENSION(nc) :: y  
-      REAL                :: s_parent,s_child
-      REAL                :: ds_parent,ds_child
-C
-C     Local variables
-      INTEGER :: i,locind_child_left,coeffraf,ii,j
-      REAL    :: xpos, invcoeffraf 
-      REAL, PARAMETER :: one_third=1./3.
-      INTEGER, DIMENSION(np) :: nbnonnuls
-      INTEGER :: diffmod
-      REAL, DIMENSION(0:5) :: invcoeff=(/1.,1.,0.5,one_third,0.25,0.2/)
-C 
-C
-      coeffraf = nint(ds_parent/ds_child)
-      invcoeffraf = 1./coeffraf      
-C      
-C
-      IF (Agrif_UseSpecialValueInUpdate) THEN
-
-      nbnonnuls = 0
-      do  j =1, coeffraf
-          do i=1, np
-               IF (y(indchildaverage(i,dir) + j -1) .NE. 
-     &               Agrif_SpecialValueFineGrid) THEN
-               nbnonnuls(i) = nbnonnuls(i) + 1
-               x(i) = x(i) +  y(indchildaverage(i,dir) + j -1 )
-               ENDIF
-          End Do
-      enddo
-      do i=1,np
-      x(i)= x(i)*invcoeff(nbnonnuls(i)) 
-      enddo
-
-      ELSE
-!CDIR NOLOOPCHG
-      do  j =1, coeffraf
-!CDIR VECTOR
-          do i=1, np
-             x(i) = x(i) + y(indchildaverage(i,dir) + j -1 )
-          enddo
-      enddo
-       x = x * invcoeffraf
-      ENDIF
-
-      Return 
-C            
-C     
-      End Subroutine average1daftercompute            
-C
-C
-C
-C     **************************************************************************  
-CCC   Subroutine Full_weighting1d  
-C     **************************************************************************  
-C
-      Subroutine full_weighting1D(x,y,np,nc,
-     &                            s_parent,s_child,ds_parent,ds_child,
-     &                            coeffraf,locind_child_left) 
-C
-CCC   Description:
-CCC   Subroutine to do an update by full_weighting on a parent grid (vector x) 
-CCC   from its child grid (vector y).
-C 
-C     Arguments
-      INTEGER             :: np,nc      
-      REAL, DIMENSION(np) :: x      
-      REAL, DIMENSION(nc) :: y  
-      REAL                :: s_parent,s_child
-      REAL                :: ds_parent,ds_child
-C
-C     Local variables
-      INTEGER :: i,locind_child_left,coeffraf
-      REAL    :: xpos,sumweight,weight
-      INTEGER :: ii,diffmod
-      REAL :: xposfin
-      INTEGER :: it1,it2
-      INTEGER :: i1,i2
-      REAL :: invsumweight
-      REAL :: weights(-(coeffraf):coeffraf)
-      
-C
-C
-      if (coeffraf == 1) then
-C        
-          x(1:np) = y(locind_child_left:locind_child_left+np-1)
-C
-          return
-C
-      endif
-C
-      xpos = s_parent      
-      
-       x = 0.
-
-       xposfin = s_child + ds_child * (locind_child_left - 1)
-       IF (abs(xposfin - xpos).LT.0.001) THEN
-          diffmod = 0
-       ELSE
-          diffmod = 1
-       ENDIF
-C
-             
-      if (diffmod == 1) THEN
-        invsumweight=1./(2.*coeffraf**2)
-        do i=-coeffraf,-1
-          weights(i) = invsumweight*(2*(coeffraf+i)+1)
-        enddo
-        do i=0,coeffraf-1
-          weights(i)=weights(-(i+1))
-        enddo
-        it1 = -coeffraf
-        i1 = -(coeffraf-1)+locind_child_left
-        i2 = 2*coeffraf - 1
-      else
-      invsumweight=1./coeffraf**2
-      do i=-(coeffraf-1),0
-        weights(i) = invsumweight*(coeffraf + i)
-      enddo
-      do i=1,coeffraf-1
-        weights(i) = invsumweight*(coeffraf - i)
-      enddo
-        it1 = -(coeffraf-1)
-        i1 = -(coeffraf-1)+locind_child_left
-        i2 = 2*coeffraf - 2
-      endif
-
-      sumweight = 0                    
-      do i = 1,np
-C
-          it2 = it1
-          Do ii = i1,i1+i2
-C
-           IF (Agrif_UseSpecialValueInUpdate) THEN
-            IF (y(ii) .NE. Agrif_SpecialValueFineGrid) THEN
-               x(i) = x(i) + weights(it2)*y(ii)
-               sumweight = sumweight+weights(it2)
-            ENDIF
-           ELSE           
-               x(i) = x(i) + weights(it2)*y(ii)
-           ENDIF           
-           
-          it2 = it2+1
-          End Do
-
-           IF (Agrif_UseSpecialValueInUpdate) THEN          
-                 IF (sumweight .NE. 0.) THEN
-                    x(i) = x(i)/sumweight
-                    sumweight = 0
-                 ELSE
-                    x(i) = Agrif_SpecialValueFineGrid
-                 ENDIF
-           ENDIF
-        
-        i1 = i1 + coeffraf
-C
-      enddo    
-C
-
-      Return 
-C            
-C
-      End Subroutine full_weighting1D 
-
-C
-      End module AGRIF_updatebasic
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdatebasic.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdatebasic.F90	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdatebasic.F90	(revision 6440)
@@ -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: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F	(revision 6439)
+++ 	(revision )
@@ -1,864 +1,0 @@
-!
-! $Id: modutil.F 2731 2011-04-08 12:05:35Z rblod $
-!
-C     Agrif (Adaptive Grid Refinement In Fortran)
-C
-C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
-C
-C     This program is free software; you can redistribute it and/or modify
-C     it under the terms of the GNU General Public License as published by
-C     the Free Software Foundation; either version 2 of the License, or
-C     (at your option) any later version.
-C
-C     This program is distributed in the hope that it will be useful,
-C     but WITHOUT ANY WARRANTY; without even the implied warranty of
-C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-C     GNU General Public License for more details.
-C
-C     You should have received a copy of the GNU General Public License
-C     along with this program; if not, write to the Free Software
-C     Foundation, Inc., 59 Temple Place-  Suite 330, Boston, MA 02111-1307, USA.
-C
-C
-C
-CCC   Module Agrif_Util 
-C 
-      Module Agrif_Util 
-C
-C
-CCC   Description:   
-CCC   This module contains the two procedures called in the main program : 
-CCC   Agrif_Init_Grids allowing the initialization of the root coarse grid, and
-CCC   Agrif_Step allowing the creation of the grid hierarchy and the management
-CCC   of the time integration. 
-C
-C     Modules used:
-C
-      Use Agrif_Clustering    
-      Use Agrif_bcfunction
-C      
-      IMPLICIT NONE
-C
-      Contains
-C     Definition of procedures contained in this module.
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Step
-C     **************************************************************************
-C 
-      Subroutine Agrif_Step(procname) 
-C
-CCC   Description:
-CCC   Subroutine to create the grid hierarchy and to manage the time integration 
-CCC   procedure. It is called in the main program.
-C
-CC    Method:
-CC    Call on subroutines Agrif_Regrid and Agrif_Integrate.
-C
-C     Declarations:
-C
-      Optional :: procname
-      External :: procname
-C
-#ifdef key_mpp_mpi
-      INCLUDE 'mpif.h'
-      Integer      :: code, ierr
-      Logical      :: mpi_was_called
-C
-C
-      Call Agrif_comm_def(MPI_COMM_AGRIF)
-
-      CALL mpi_initialized ( mpi_was_called, code )
-      IF( code /= MPI_SUCCESS ) THEN
-         WRITE(*, *) ': Error in routine mpi_initialized'
-         CALL mpi_abort( mpi_comm_world, code, ierr )
-      ENDIF
-
-      IF( .NOT. mpi_was_called ) THEN
-         CALL mpi_comm_dup( mpi_comm_world, MPI_COMM_AGRIF, code)
-         IF( code /= MPI_SUCCESS ) THEN
-            WRITE(*, *) ' Agrif_Step: Error in routine mpi_comm_dup'
-            CALL mpi_abort( mpi_comm_world, code, ierr )
-         ENDIF
-      ENDIF
-
-      If (Agrif_Mygrid % ngridstep == 0) Then
-          Call MPI_COMM_SIZE(MPI_COMM_AGRIF,Agrif_Nbprocs,code)
-          Call MPI_COMM_RANK(MPI_COMM_AGRIF,Agrif_ProcRank,code)
-          Call MPI_COMM_GROUP(MPI_COMM_AGRIF,Agrif_Group,code)
-      endif
-#endif
-C
-C     Creation and initialization of the grid hierarchy 
-C
-C  
-C    Set the clustering variables
-C
-      Call Agrif_clustering_def()
-C      
-      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 1 ) then
-C     
-         If (Agrif_Mygrid % ngridstep == 0) then
-C
-            Call Agrif_Regrid
-C 
-            Call Agrif_Instance           
-     &          (Agrif_Mygrid)           
-         endif
-C
-      else
-C    
-         If (mod(Agrif_Mygrid % ngridstep, Agrif_Regridding) == 0) then
-C
-            Call Agrif_Regrid
-C  
-            Call Agrif_Instance           
-     &          (Agrif_Mygrid)  
-C            
-         endif
-C
-      endif
-C
-C     Time integration of the grid hierarchy
-C
-      If (present(procname)) Then
-         Call Agrif_Integrate (Agrif_Mygrid,procname)
-      Else
-         Call Agrif_Integrate (Agrif_Mygrid)      
-      endif
-C    
-      If (associated(Agrif_Mygrid%child_grids)) 
-     &   Call Agrif_Instance (Agrif_Mygrid)
-C
-      Return
-C             
-      End Subroutine Agrif_Step      
-
-C     **************************************************************************
-CCC   Subroutine Agrif_Step_Child
-C     **************************************************************************
-C
-      Subroutine Agrif_Step_Child(procname)
-C
-CCC   Description:
-CCC   Subroutine to create the grid hierarchy and to manage the time integration
-CCC   procedure. It is called in the main program.
-C
-CC    Method:
-CC    Call on subroutines Agrif_Regrid and Agrif_Integrate.
-C
-C     Declarations:
-C
-      Optional :: procname
-      External :: procname
-C
-C     Time integration of the grid hierarchy
-C
-      If (present(procname)) Then
-         Call Agrif_Integrate_Child (Agrif_Mygrid,procname)
-      Else
-         Call Agrif_Integrate_Child (Agrif_Mygrid)
-      endif
-C    
-      If (associated(Agrif_Mygrid%child_grids))
-     &   Call Agrif_Instance (Agrif_Mygrid)
-C
-      Return
-C
-      End Subroutine Agrif_Step_Child
-
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Regrid
-C     **************************************************************************
-C
-      Subroutine Agrif_Regrid
-C
-CCC   Description:
-CCC   Subroutine to create the grid hierarchy from fixed grids and 
-CC       adaptive mesh refinement.
-C
-CC    Method:        
-C
-C     Declarations:
-C
-C     Local variables      
-      Type(Agrif_Rectangle), Pointer     :: coarsegrid_fixed
-      Type(Agrif_Rectangle), Pointer     :: coarsegrid_moving  
-      INTEGER                            :: j
-      INTEGER :: nunit
-      INTEGER                            :: iii
-      Logical :: BEXIST
-C 
-      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 )
-     &   Call Agrif_detect_all(Agrif_Mygrid) ! Detection of areas to be refined
-C
-      Allocate(coarsegrid_fixed)
-      Allocate(coarsegrid_moving)
-C
-      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) 
-     &    Call Agrif_Cluster_All(Agrif_Mygrid,coarsegrid_moving) ! Clustering
-C
-      if ( Agrif_USE_FIXED_GRIDS .EQ. 1 .OR. 
-     &     Agrif_USE_ONLY_FIXED_GRIDS .EQ. 1 ) then
-C
-      If (Agrif_Mygrid % ngridstep == 0) Then
-          nunit = Agrif_Get_Unit()
-          open(nunit,file='AGRIF_FixedGrids.in',form='formatted',
-     &           status="old",ERR=99) ! Opening of the Agrif_FixedGrids.in file
-          j = 1
-C         Creation of the grid hierarchy from the Agrif_FixedGrids.in file 
-            do iii = 1 , Agrif_Probdim
-               coarsegrid_fixed % imin(iii) = 1
-               coarsegrid_fixed % imax(iii) = Agrif_Mygrid % nb(iii) + 1
-            enddo
-C      
-            Call Agrif_Read_Fix_Grd (coarsegrid_fixed,j,nunit)     
-            close(nunit) ! Closing of the Agrif_FixedGrids.in file 
-C
-          Nullify(Agrif_oldmygrid)
-          Nullify(Agrif_Mygrid  % child_grids)
-C        
-C         Creation of the grid hierarchy from coarsegrid_fixed
-            Call Agrif_Create_Grids (Agrif_Mygrid,coarsegrid_fixed)
-        Else        
-          Agrif_oldmygrid => Agrif_Mygrid % child_grids
-         endif
-      else
-      Agrif_oldmygrid => Agrif_Mygrid % child_grids
-      Nullify(Agrif_Mygrid  % child_grids)
-      endif
-C
-      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
-C
-      Call Agrif_Save_All(Agrif_oldmygrid)      
-C      
-      Call Agrif_Free_before_All(Agrif_oldmygrid)
-C 
-C     Creation of the grid hierarchy from coarsegrid_moving    
-      Call Agrif_Create_Grids
-     &     (Agrif_Mygrid,coarsegrid_moving)
-C
-      endif
-C
-C     Initialization of the grid hierarchy by copy or interpolation
-C
-      Call Agrif_Init_Hierarchy(Agrif_Mygrid)
-C
-      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) 
-     &        Call Agrif_Free_after_All(Agrif_oldmygrid)
-C
-      Deallocate(coarsegrid_fixed)
-      Deallocate(coarsegrid_moving)
-C      
-      Return
-C
-C     Opening error
-C
-   99 INQUIRE(FILE='AGRIF_FixedGrids.in',EXIST=BEXIST)
-      If (.not. BEXIST) Then
-          print*,'ERROR : File AGRIF_FixedGrids.in not found.'
-          STOP 
-        Else
-          print*,'Error opening file AGRIF_FixedGrids.in'
-          STOP         
-      endif     
-C      
-      End Subroutine Agrif_Regrid
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_detect_All
-C     **************************************************************************
-C
-      Recursive Subroutine Agrif_detect_all(g)
-C
-CCC   Description:
-CCC   Subroutine to detect areas to be refined.
-C
-CC    Method:        
-C
-C     Declarations:
-C
-      
-C      
-C     Pointer argument    
-      TYPE(Agrif_Grid) ,pointer  :: g        ! Pointer on the current grid
-C      
-C     Local variables
-      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive 
-                                             ! procedure      
-      INTEGER, DIMENSION(3)      :: size
-      INTEGER                    :: iii
-      Real :: g_eps     
-C
-      parcours => g % child_grids
-C  
-C     To be positioned on the finer grids of the grid hierarchy          
-C  
-      do while (associated(parcours))       
-         Call Agrif_detect_all (parcours % gr)  
-        parcours => parcours % next             
-      enddo
-C
-      g_eps = huge(1.)
-      do iii = 1 , Agrif_Probdim
-         g_eps=min(g_eps,g%Agrif_d(iii))
-      enddo
-C
-      g_eps = g_eps/100.
-C          
-      if ( Agrif_Probdim .EQ. 1 ) g%tabpoint1D=0
-      if ( Agrif_Probdim .EQ. 2 ) g%tabpoint2D=0
-      if ( Agrif_Probdim .EQ. 3 ) g%tabpoint3D=0
-C      
-      do iii = 1 , Agrif_Probdim
-         if (g%Agrif_d(iii)/Agrif_coeffref(iii).LT.
-     &                     (Agrif_mind(iii)-g_eps)) Return
-      enddo
-C                                       
-      Call Agrif_instance(g)
-C  
-C     Detection (Agrif_detect is a user s routine)
-C      
-     
-      do iii = 1 , Agrif_Probdim
-         size(iii) = g%nb(iii) + 1
-      enddo
-C
-      SELECT CASE (Agrif_Probdim)
-      CASE (1) 
-         Call Agrif_detect(g%tabpoint1D,size)
-      CASE (2) 
-         Call Agrif_detect(g%tabpoint2D,size)
-      CASE (3) 
-         Call Agrif_detect(g%tabpoint3D,size)
-      END SELECT
-C
-C     Addition of the areas detected on the child grids
-C      
-      parcours => g % child_grids 
-C           
-      Do while (associated(parcours))
-        Call Agrif_Add_detected_areas (g,parcours % gr)
-        parcours => parcours % next 
-      enddo
-C     
-      Return      
-C
-      End Subroutine Agrif_detect_all
-C      
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Add_detected_areas
-C     **************************************************************************
-C      
-      Subroutine Agrif_Add_detected_areas(parentgrid,childgrid)
-C
-CCC   Description:
-CCC   Subroutine to add on the parent grid the areas detected 
-CC       on its child grids.
-C
-CC    Method:        
-C
-C     Declarations:
-C
-      
-C 
-      Type(Agrif_Grid),pointer   :: parentgrid,childgrid
-C      
-      Integer :: i,j,k
-C
-      do i = 1,childgrid%nb(1)+1
-         if ( Agrif_Probdim .EQ. 1 ) then
-            If (childgrid%tabpoint1D(i).EQ.1) Then
-                parentgrid%tabpoint1D(childgrid%ix(1)+
-     &                 (i-1)/Agrif_Coeffref(1)) = 1
-            endif
-         else
-            do j=1,childgrid%nb(2)+1
-               if (Agrif_Probdim.EQ.2) then
-              If (childgrid%tabpoint2D(i,j).EQ.1) Then
-                  parentgrid%tabpoint2D(
-     &                  childgrid%ix(1)+(i-1)/Agrif_Coeffref(1),
-     &                  childgrid%ix(2)+(j-1)/Agrif_Coeffref(2)) = 1
-                  endif
-               else
-                  do k=1,childgrid%nb(3)+1
-                If (childgrid%tabpoint3D(i,j,k).EQ.1) Then
-                    parentgrid%tabpoint3D(
-     &                     childgrid%ix(1)+(i-1)/Agrif_Coeffref(1),
-     &                     childgrid%ix(2)+(j-1)/Agrif_Coeffref(2),
-     &                     childgrid%ix(3)+(k-1)/Agrif_Coeffref(3)) = 1
-                     endif
-                  enddo
-               endif
-            enddo
-         endif
-      enddo
-C      
-      Return
-C
-      End Subroutine Agrif_Add_detected_areas   
-C      
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Free_before_All
-C     **************************************************************************
-C
-      Recursive Subroutine Agrif_Free_before_All(g)
-C
-CCC   Description:
-C
-CC    Method:        
-C
-C     Declarations:
-C
-C     Pointer argument    
-      Type(Agrif_pgrid),pointer   :: g        ! Pointer on the current grid
-C
-C     Local pointer
-      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive 
-                                             ! procedure      
-C
-C
-      parcours => g        
-C      
-      Do while (associated(parcours))     
-        If (.not. parcours%gr%fixed) Then
-            Call Agrif_Free_data_before(parcours%gr)
-            parcours % gr % oldgrid = .TRUE.        
-        endif
-C
-        Call Agrif_Free_before_all (parcours % gr % child_grids)
-C  
-        parcours => parcours % next             
-      enddo
-C     
-      Return      
-C
-C
-      End Subroutine Agrif_Free_before_All
-C     **************************************************************************
-CCC   Subroutine Agrif_Save_All
-C     **************************************************************************
-C
-      Recursive Subroutine Agrif_Save_All(g)
-C
-CCC   Description:
-C
-CC    Method:        
-C
-C     Declarations:
-C
-C     Pointer argument    
-      Type(Agrif_pgrid),pointer   :: g        ! Pointer on the current grid
-C
-C     Local pointer
-      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive 
-                                             ! procedure      
-C
-C
-      parcours => g        
-C      
-      Do while (associated(parcours))     
-        If (.not. parcours%gr%fixed) Then
-            Call Agrif_Instance(parcours%gr)
-            Call Agrif_Before_Regridding()
-            parcours % gr % oldgrid = .TRUE.        
-        endif
-C
-        Call Agrif_Save_All (parcours % gr % child_grids)
-C  
-        parcours => parcours % next             
-      enddo
-C     
-      Return      
-C
-C
-      End Subroutine Agrif_Save_All      
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Free_after_All
-C     **************************************************************************
-C
-      Recursive Subroutine Agrif_Free_after_All(g)
-C
-CCC   Description:
-C
-CC    Method:        
-C
-C     Declarations:
-C
-      
-C      
-C     Pointer argument    
-      Type(Agrif_pgrid),pointer   :: g       ! Pointer on the current grid
-C
-C     Local pointers
-      TYPE(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive proced
-      Type(Agrif_pgrid),pointer  :: preparcours   
-      Type(Agrif_pgrid),pointer  :: preparcoursini 
-C
-C
-      Allocate(preparcours)
-C 
-      preparcoursini => preparcours
-C 
-      Nullify(preparcours % gr)
-C 
-      preparcours % next => g
-C
-      parcours => g
-C      
-      Do while (associated(parcours))
-C
-         if ( (.NOT. parcours% gr% fixed) .AND.
-     &        (parcours% gr% oldgrid    ) ) then
-          Call Agrif_Free_data_after(parcours%gr)
-         endif
-C
-         Call Agrif_Free_after_all (parcours % gr % child_grids)
-C
-      If (parcours % gr % oldgrid) Then
-          Deallocate(parcours % gr)
-          preparcours % next => parcours % next
-          Deallocate(parcours)
-          parcours => preparcours % next
-        Else
-          preparcours => preparcours % next
-          parcours => parcours % next 
-         endif       
-      enddo
-C
-      Deallocate(preparcoursini)
-C     
-      Return      
-C
-      End Subroutine Agrif_Free_after_All
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Integrate
-C     **************************************************************************
-C
-      Recursive Subroutine Agrif_Integrate(g, procname)         
-C
-CCC   Description:
-CCC   Subroutine to manage the time integration of the grid hierarchy.
-C
-CC    Method:
-CC    Recursive subroutine and call on subroutines Agrif_Instance & Agrif_Step
-C
-C     Declarations:
-C
-      
-C      
-C     Pointer argument    
-      Type(Agrif_Grid),pointer   :: g        ! Pointer on the current grid
-C
-C     main procedure name
-      Optional :: procname
-      External :: procname      
-C      
-C     Local pointer
-      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive 
-                                             ! procedure
-C
-C     Local scalars
-      INTEGER                    :: nbt      ! Number of time steps 
-                                             ! of the current grid
-      INTEGER                    :: k        
-      INTEGER                    :: iii
-C  
-C     Instanciation of the variables of the current grid
-      If (g%fixedrank .NE.0) Then      
-      Call Agrif_Instance
-     &     (g)
-      End If
-C       
-C     One step on the current grid      
-C
-      If (present(procname)) Then
-         Call procname ()      
-      Else
-        write(*,*) 'The name of the step subroutine has not '
-        write(*,*) 'been given in the subroutine Agrif_Integrate'
-        stop
-      endif
-C
-C     Number of time steps on the current grid      
-C
-      g%ngridstep = g % ngridstep + 1
-C      
-      parcours => g % child_grids
-C    
-C     Recursive procedure for the time integration of the grid hierarchy      
-      Do while (associated(parcours))
-C
-C       Instanciation of the variables of the current grid            
-        Call Agrif_Instance
-     &           (parcours % gr)
-C       
-C       Number of time steps
-        nbt = 1
-        do iii = 1 , Agrif_Probdim
-           nbt = max(nbt, parcours % gr % timeref(iii))
-        enddo
-C       
-        Do k = 1,nbt
-C       
-           If (present(procname)) Then
-                 Call Agrif_Integrate (parcours % gr, procname)
-           Else
-                 Call Agrif_Integrate (parcours % gr)      
-           endif
-C       
-        enddo     
-C  
-        parcours => parcours % next
-C     
-      enddo
-C
-C      
-      End Subroutine Agrif_Integrate 
-
-C     **************************************************************************
-CCC   Subroutine Agrif_Integrate_Child
-C     **************************************************************************
-C
-      Recursive Subroutine Agrif_Integrate_Child(g,procname)
-C
-CCC   Description:
-CCC   Subroutine to manage the time integration of the grid hierarchy.
-C
-CC    Method:
-CC    Recursive subroutine and call on subroutines Agrif_Instance & Agrif_Step.
-C
-C     Declarations:
-C
-
-C
-C     Pointer argument
-      Type(Agrif_Grid),pointer   :: g        ! Pointer on the current grid
-C
-C     main procedure name
-      Optional :: procname
-      External :: procname
-C
-C     Local pointer
-      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive
-                                             ! procedure
-C
-C     One step on the current grid
-C
-      If (present(procname)) Then
-         Call procname ()      
-      Else
-        write(*,*) 'The name of the step subroutine has not '
-        write(*,*) 'been given in the subroutine Agrif_Integrate'
-        stop
-      endif
-C
-C     Number of time steps on the current grid
-C
-C
-      parcours => g % child_grids
-C
-C     Recursive procedure for the time integration of the grid hierarchy      
-      Do while (associated(parcours))
-C
-C       Instanciation of the variables of the current grid
-        Call Agrif_Instance
-     &           (parcours % gr)
-
-C       
-           If (present(procname)) Then
-                 Call Agrif_Integrate_Child (parcours % gr, procname)
-           Else
-                 Call Agrif_Integrate_Child (parcours % gr)
-           endif
-C  
-        parcours => parcours % next
-C     
-      enddo
-C
-C
-      End Subroutine Agrif_Integrate_Child
-
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Init_Grids
-C     **************************************************************************
-C      
-      Subroutine Agrif_Init_Grids
-C
-CCC   Description:
-CCC   Subroutine to initialize the root coarse grid pointed by Agrif_Mygrid. 
-CCC   It is called in the main program.
-C
-C     Declarations:
-C
-C
-      INTEGER :: iii
-C
-C             definition of the probdim and modtypes variables
-C
-#ifdef key_mpp_mpi
-      INCLUDE 'mpif.h'
-      Agrif_MPIPREC = MPI_DOUBLE_PRECISION
-#endif
-      Call Agrif_probdim_modtype_def()
-C      
-      Agrif_UseSpecialValue = .FALSE.
-      Agrif_UseSpecialValueFineGrid = .FALSE.
-      Agrif_SpecialValue = 0.
-      Agrif_SpecialValueFineGrid = 0.
-C      
-C     Allocation of Agrif_Mygrid
-      allocate(Agrif_Mygrid)
-C      
-C     Space and time refinement factors are set to 1 on the root grid
-C
-      do iii = 1 , Agrif_Probdim
-         Agrif_Mygrid % spaceref(iii) = 1
-         Agrif_Mygrid % timeref(iii) = 1
-      enddo
-C      
-C     Initialization of the number of time steps    
-      Agrif_Mygrid % ngridstep = 0
-      Agrif_Mygrid % grid_id = 0
-C
-C     No parent grid for the root coarse grid
-      Nullify(Agrif_Mygrid % parent)
-C      
-C     Initialization of the minimum positions, global abscissa and space steps  
-      do iii= 1 ,  Agrif_Probdim
-         Agrif_Mygrid % ix(iii) = 1            
-         Agrif_Mygrid % Agrif_x(iii) = 0.
-         Agrif_Mygrid % Agrif_d(iii) = 1. 
-C     Borders of the root coarse grid 
-         Agrif_Mygrid % NearRootBorder(iii) = .true.  
-         Agrif_Mygrid % DistantRootBorder(iii) = .true.      
-      enddo
-C  
-C     The root coarse grid is a fixed grid
-      Agrif_Mygrid % fixed = .TRUE.
-C     Level of the root grid
-      Agrif_Mygrid % level = 0
-C     Maximum level in the hierarchy
-      Agrif_MaxLevelLoc = 0
-      
-C      
-C     Number of the grid pointed by Agrif_Mygrid (root coarse grid)
-      Agrif_Mygrid % rank = 1      
-C 
-C     Number of the root grid as a fixed grid   
-      Agrif_Mygrid % fixedrank = 0  
-C 
-C     Initialization of some fields of the root grid variables     
-      Call Agrif_Create_Var (Agrif_Mygrid)
-C      
-C     Initialization of the other fields of the root grid variables (number of 
-C     cells, positions, number and type of its dimensions, ...)  
-      Call Agrif_Set_numberofcells(Agrif_Mygrid)
-C      
-      Call Agrif_Instance (Agrif_Mygrid)        
-C
-      Call Agrif_Set_numberofcells(Agrif_Mygrid)          
-C             
-C     Allocation of the array containing the values of the grid variables
-      Call Agrif_Allocation (Agrif_Mygrid)
-C        
-      Call Agrif_initialisations(Agrif_Mygrid)    
-C      
-      nullify(Agrif_Mygrid % child_grids)
-C 
-C     Total number of fixed grids   
-      Agrif_nbfixedgrids = 0         
-C      
-      Call Agrif_Instance (Agrif_Mygrid)
-C        
-      End Subroutine Agrif_Init_Grids  
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Deallocation
-C     **************************************************************************
-C      
-      Subroutine Agrif_Deallocation
-C
-CCC   Description:
-CCC   Subroutine to initialize the root coarse grid pointed by Agrif_Mygrid. 
-CCC   It is called in the main program.
-C
-C     Declarations:
-C
-C
-      INTEGER :: nb
-C
-C             definition of the probdim and modtypes variables
-C
-      do nb = 1, Agrif_NbVariables
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array1) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array1)
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array2) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array2)
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array3) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array3)
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array4) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array4)
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array5) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array5)
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array6) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array6)
-C
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray1) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray1)
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray2) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray2)
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray3) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray3)
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray4) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray4)
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray5) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray5)
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray6) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray6)
-C
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray1) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray1)
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray2) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray2)
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray3) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray3)
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray4) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray4)
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray5) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray5)
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray6) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray6)
-C
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % carray1) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % carray1)
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % carray2) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % carray2)
-      enddo
-C
-      do nb = 1, Agrif_NbVariables
-        Deallocate(Agrif_Mygrid % tabvars(nb) % var)
-      enddo
-C
-      Deallocate(Agrif_Mygrid % tabvars)
-C
-      Deallocate(Agrif_Mygrid)
-C
-      End Subroutine  Agrif_Deallocation 
-C
-      End module Agrif_Util 
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F90	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F90	(revision 6440)
@@ -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: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modvariables.F
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modvariables.F	(revision 6439)
+++ 	(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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modvariables.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modvariables.F90	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modvariables.F90	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LEX/Makefile.lex
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LEX/Makefile.lex	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LEX/Makefile.lex	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LEX/convert.lex
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LEX/convert.lex	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LEX/convert.lex	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LEX/convert.y
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LEX/convert.y	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LEX/convert.y	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LEX/decl.h
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LEX/decl.h	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LEX/decl.h	(revision 6440)
@@ -0,0 +1,662 @@
+/******************************************************************************/
+/*                                                                            */
+/*     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 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
+
+/******************************************************************************/
+/*********** Declaration of structures used in conv ***************************/
+/******************************************************************************/
+
+typedef struct
+{
+   char first[LONG_M];
+   char last[LONG_M];
+} typedim ;                /* fortran dimension as 'ndeb:nfin'                */
+
+typedef struct listdim
+{
+   typedim dim;
+   struct listdim *suiv;
+} listdim;                 /* list of the dimensions of a variable            */
+
+typedef struct variable
+{
+   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_M];
+   char v_IntentSpec[LONG_M];
+   char v_readedlistdimension[LONG_M];
+   int  v_nbdim;
+   int  v_common;
+   int  v_positioninblock;
+   int  v_module;
+   int  v_save;
+   int  v_catvar;
+   int  v_VariableIsParameter;
+   int  v_PublicDeclare;
+   int  v_PrivateDeclare;
+   int  v_ExternalDeclare;
+   int  v_pointedvar;
+   int  v_notgrid;
+   int  v_dimensiongiven;
+   int  v_c_star;
+   int  v_indicetabvars;
+   int  v_pointerdeclare;
+   int  v_optionaldeclare;
+   int  v_allocatable;
+   int  v_target;
+   int  v_dimsempty;
+   listdim *v_dimension;
+} variable ;               /* type of a variable                              */
+                           /* v_typevar : type (integer, real, ...)           */
+                           /* v_nomvar : name of the variable                 */
+                           /* v_dimension : list of dimensions of the variable*/
+                           /* v_nbdim: 1 if the variable is 1d, etc ...       */
+                           /* precision : Name of the variable which          */
+                           /* determine the precision. example : wp in the    */
+                           /* case where REAL(wp)                             */
+
+typedef struct listvar
+{
+   variable *var ;
+   struct listvar * suiv;
+} listvar ;                /* list of variables                               */
+
+
+typedef struct listusemodule
+{
+   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;
+} listusemodule;           /* list of names                                   */
+
+typedef struct listparameter
+{
+   char p_name[LONG_M];
+   char p_modulename[LONG_M];
+   struct listparameter * suiv;
+} listparameter ;           /* list of names                                  */
+
+typedef struct listname
+{
+   char n_name[LONG_VNAME];
+   struct  listname* suiv;
+} listname ;            /* list of names                                  */
+
+typedef struct listcouple
+{
+   char c_namevar[LONG_VNAME];
+   char c_namepointedvar[LONG_VNAME];
+   struct listcouple * suiv;
+} listcouple;              /* list of names                                   */
+
+
+typedef struct listnom
+{
+   char o_nom[LONG_C];
+   char o_module[LONG_VNAME];
+   char o_subroutinename[LONG_M];
+   int  o_val;
+   listcouple *couple;
+   struct listnom * suiv;
+} listnom;                 /* list of names                                   */
+
+
+typedef struct listallocate
+{
+   char a_nomvar[LONG_C];
+   char a_subroutine[LONG_VNAME];
+   char a_module[LONG_VNAME];
+   struct listallocate * suiv;
+} listallocate ;
+
+
+typedef struct listvarpointtovar
+{
+   char t_usemodule[LONG_VNAME];
+   char t_cursubroutine[LONG_VNAME];
+   listcouple *t_couple;
+   struct  listvarpointtovar* suiv;
+}listvarpointtovar ;       /* list of names                                   */
+
+
+typedef struct listindice
+{
+   int i_indice;
+   struct  listindice * suiv;
+} listindice;              /* list of indiced                                 */
+
+ variable *curvar;
+
+ listvar *List_ModuleUsedInModuleUsed_Var;
+ listvar *List_ModuleUsed_Var;
+ listvar *listduplicated;
+
+ listvar *List_GlobalParameter_Var;
+ listvar *List_Global_Var;
+ listvar *List_Data_Var;
+ listvar *List_Data_Var_Cur;
+ listvar *List_Save_Var;
+ listvar *List_SubroutineArgument_Var;
+ listvar *List_SubroutineDeclaration_Var;
+ listvar *List_UsedInSubroutine_Var;
+ listvar *List_Parameter_Var;
+ listvar *List_Dimension_Var;
+ listvar *List_FunctionType_Var;
+ listvar *List_NotGridDepend_Var;
+ listvar *List_Common_Var;
+
+
+ listname *List_Pointer_Var;
+ listname *List_ImplicitNoneSubroutine;
+
+ listusemodule *List_NameOfModuleUsed;
+ listusemodule *List_Include;
+ listusemodule *listofmoduletmp;
+ listusemodule *tmpuselocallist;
+
+ listparameter *List_GlobParamModuleUsedInModuleUsed_Var;
+ listparameter *List_GlobParamModuleUsed_Var;
+
+ listnom *List_ContainsSubroutine;
+ listnom *List_Subroutine_For_Alloc;
+ listnom *listofmodules;
+ listnom *listofkind;
+ listnom *List_NameOfModule;
+ listnom *List_NameOfCommon;
+ listnom *List_SubroutineWhereAgrifUsed;
+
+ listallocate *List_Allocate_Var;
+
+ listvarpointtovar *List_CouplePointed_Var;
+                           /*  variables which are pointed to an other one    */
+
+ listindice *Listofavailableindices;
+                           /* List of available indices in the tabvars table  */
+ listindice **Listofavailableindices_glob;
+
+ listdim *curdim;
+ listdim *commondim;
+
+/******************************************************************************/
+/****************   *** COMMON Variables ***  *********************************/
+/******************************************************************************/
+
+ int positioninblock;
+ char commonvar[LONG_VNAME];
+ char commonblockname[LONG_VNAME];
+
+/******************************************************************************/
+/****************   *** AGRIF Variables ***   *********************************/
+/******************************************************************************/
+ int inagrifcallargument;
+ int afterpercent;
+ int sameagrifargument;
+ int InAgrifParentDef;
+ char sameagrifname[LONG_VNAME];
+/******************************************************************************/
+/****************   *** VAR DEF Variables ***   *******************************/
+/******************************************************************************/
+ 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 */
+ int InitialValueGiven;    /* An initial value has been given */
+ int Allocatabledeclare;
+ int Targetdeclare;
+ int SaveDeclare;
+ int functiondeclarationisdone;
+ int pointerdeclare;
+ int optionaldeclare;
+ int inside_type_declare;
+ int VariableIsParameter;
+ int dimsgiven;
+ int shouldincludempif;
+ int c_star;
+ char DeclType[LONG_VNAME];
+ char nameinttypename[LONG_VNAME];
+ char nameinttypenameback[LONG_VNAME];
+ int GlobalDeclaration;
+ int GlobalDeclarationType;
+ char InitValue[LONG_M];
+ char IntentSpec[LONG_M];
+ char NamePrecision[LONG_C];
+ char CharacterSize[LONG_VNAME];
+ char vallengspec[LONG_VNAME];
+ int isrecursive;
+ int is_result_present;
+
+/******************************************************************************/
+/****************   *** CONV Variables ***   **********************************/
+/******************************************************************************/
+ int dimprob ;             /* dimension of the problem : 1 for 1D,2 for 2D,   */
+                           /*    3 for 3D                                     */
+ int onlyfixedgrids;       /* = 1 if onlyfixedgrids is true                   */
+ int todebug;
+ int fixedgrids;           /* = 1 if fixedgrids is true                       */
+ 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;
+ int IndicenbmaillesZ;
+
+ int inmodulemeet;
+ int incalldeclare;
+ int aftercontainsdeclare; /* Signale si l'on vient d'un contains ou non */
+ int retour77;
+ int callagrifinitgrids;
+ int callmpiinit;
+ int firstpass;
+ int pointedvar;
+ int NbMailleXDefined;
+ int agrif_parentcall;
+ int didvariableadded;
+ int SubloopScalar;        /* = 1 we should put in argument of sub_loop       */
+                           /*    only                                         */
+                           /*    scalar and not table u(1,1,1) in place of u  */
+ int inprogramdeclare;
+ int insubroutinedeclare;
+ int inmoduledeclare;
+ int dimsempty;
+ int created_dimensionlist;
+ int incontainssubroutine;
+
+ 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 *allocationagrif;
+
+ long int pos_cur;         /* current position in the output file             */
+ long int pos_curagrifparent;
+                           /* current position in the output file             */
+ long int pos_curcall;     /* current position in the output file             */
+ long int pos_curuse;      /* current position in the output file             */
+ long int pos_curuseold;   /* current position in the output file             */
+ long int pos_curfunction; /* current position in the output file             */
+ long int pos_cur_decl;    /* current position in the output file             */
+ long int pos_curdata;     /* current position in the output file             */
+ long int pos_curparameter;/* current position in the output file             */
+ long int pos_curcommon;   /* current position in the output file             */
+ long int pos_cursave;     /* current position in the output file             */
+ long int pos_curdimension;/* 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                */
+ long int pos_endsubroutine;
+                           /* final position of a line in file                */
+
+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;
+ int value_char_size2;
+ int value_char_size3;
+
+
+ int inallocate;
+ int infixed;
+ int infree;
+/******************************************************************************/
+/*********** 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 process_fortran(const char *input_file);
+extern int fortran_error(const char *s);
+/******************************************************************************/
+/*********** dependfile.c *****************************************************/
+/******************************************************************************/
+extern void Writethedependnbxnbyfile();
+extern void Readthedependnbxnbyfile();
+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 is_dependfile_created(const char *NameTampon);
+extern void Write_val_max();
+extern void Read_val_max();
+/******************************************************************************/
+/*********** DiversListe.c ****************************************************/
+/******************************************************************************/
+extern void Add_Common_var_1();
+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(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 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);
+extern void closeandcallsubloop_contains_0();
+/******************************************************************************/
+/*********** toamr.c **********************************************************/
+/******************************************************************************/
+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_initialisationsagrif_file(variable *v,FILE *initproc,int *VarnameEmpty);
+extern void write_Setnumberofcells_file();
+extern void write_Getnumberofcells_file();
+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();
+/******************************************************************************/
+/*********** UtilAgrif.c ******************************************************/
+/******************************************************************************/
+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(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(const char name[LONG_M],char toprint[LONG_M],
+                                             listvar * listtosee, int whichone);
+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 * 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 void copyuse_0(const char *namemodule);
+extern void copyuseonly_0(const char *namemodule);
+/******************************************************************************/
+/*********** UtilFortran.c ****************************************************/
+/******************************************************************************/
+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, const char *module,
+                                                                 FILE *fileout,long int oldposcuruse);
+extern void Write_Word_end_module_0();
+extern void Add_Subroutine_For_Alloc(const char *nom);
+extern void Write_Closing_Module();
+extern int IsTabvarsUseInArgument_0();
+extern int ImplicitNoneInSubroutine();
+extern void Add_Pointer_Var_From_List_1(listvar *listin);
+extern void Add_Pointer_Var_1(char *nom);
+extern int varispointer_0(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(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 get_num_dims(const listdim *d);
+extern variable * createvar(const char *nom, listdim *d);
+extern listvar * insertvar(listvar *lin,variable *v);
+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 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 *************************************************/
+/******************************************************************************/
+extern void Add_NotGridDepend_Var_1 (char *name);
+extern int VarIsNonGridDepend(char *name);
+/******************************************************************************/
+/*********** WorkWithAllocatelist.c *******************************************/
+/******************************************************************************/
+extern void Add_Allocate_Var_1(const char *nom, const char *nommodule);
+extern int IsVarAllocatable_0(const char *ident);
+/******************************************************************************/
+/*********** WorkWithglobliste.c **********************************************/
+/******************************************************************************/
+extern void Add_Globliste_1(listvar *listtoadd);
+extern void Add_SubroutineDeclarationSave_Var_1(listvar *listtoadd);
+extern void checkandchangedims(listvar *listsecondpass);
+/******************************************************************************/
+/*********** WorkWithlistdatavariable.c ***************************************/
+/******************************************************************************/
+extern void Add_Data_Var_1 (listvar **curlist,char *name,char *values);
+extern void Add_Data_Var_Names_01 (listvar **curlist,listname *l1, listname *l2);
+/******************************************************************************/
+/*********** WorkWithlistmoduleinfile.c ***************************************/
+/******************************************************************************/
+extern void Save_Length(const char *nom, int whichone);
+extern void Save_Length_int(int val, int whichone);
+/******************************************************************************/
+/*********** WorkWithlistofmodulebysubroutine.c *******************************/
+/******************************************************************************/
+extern void RecordUseModulesVariables();
+extern void  RecordUseModulesUseModulesVariables();
+extern void Add_NameOfModuleUsed_1(char *name);
+extern void Addmoduletothelist(const char *name);
+extern void WriteUsemoduleDeclaration(const char *cursubroutinename);
+/******************************************************************************/
+/*********** WorkWithlistvarindoloop.c ****************************************/
+/******************************************************************************/
+extern void Add_UsedInSubroutine_Var_1 (const char *ident);
+extern void ajoutevarindoloop_definedimension (char *name);
+extern void  ModifyThelistvarindoloop();
+extern void  CompleteThelistvarindoloop();
+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();
+extern void Update_List_From_Common_Var(listvar *list_to_modify);
+extern void Update_List_Var(listvar *list_to_modify);
+extern void List_UsedInSubroutine_Var_Update_From_Module_Used();
+extern void Update_NotGridDepend_Var(listvar *list_to_modify);
+extern int LookingForVariableInList(listvar *listin,variable *var);
+extern int LookingForVariableInListGlobal(listvar *listin,variable *var);
+extern int LookingForVariableInListName(listvar *listin,const char *var);
+extern int LookingForVariableInListGlob(listvar *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();
+extern void ListClean();
+extern void ListUpdate();
+extern void GiveTypeOfVariables();
+extern void Sort_List_SubroutineArgument_Var();
+extern void IndiceTabvars_Global_Var_Treated(char *nom);
+extern void IndiceTabvars_Global_Var_No_Treated(char *nom);
+extern void UpdateTheRemainingList(listvar *record);
+extern void IndiceTabvars_Common_Var_Treated(char *nom);
+extern void IndiceTabvars_Common_Var_No_Treated(char *nom);
+extern void IndiceTabvarsIdentification();
+extern void New_Allocate_Subroutine_Is_Necessary();
+extern void New_Allocate_Subroutine_For_Common_Is_Necessary();
+extern void NewModule_Creation_0();
+extern void UpdateList_SubroutineWhereAgrifUsed();
+extern void UpdateList_UsedInSubroutine_With_dimension();
+extern void Affiche(listvar *parcours);
+extern int SubInList_ContainsSubroutine();
+extern void update_indicemaxtabvars(variable *var,listindice **Listofindices);
+/******************************************************************************/
+/*********** WorkWithParameterlist.c ******************************************/
+/******************************************************************************/
+extern void Add_GlobalParameter_Var_1(listvar *listin);
+extern void Add_Parameter_Var_1(listvar *listin);
+extern void Add_Dimension_Var_1(listvar *listin);
+/******************************************************************************/
+/*********** WorkWithvarofsubroutineliste.c ***********************************/
+/******************************************************************************/
+extern void Add_SubroutineArgument_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_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(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);
+/******************************************************************************/
+/*********** WriteInFile.c ****************************************************/
+/******************************************************************************/
+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 RemoveWordSET_0(FILE * filout, long int position, int sizetoremove);
+extern void RemoveWordCUR_0(FILE * filout, int sizetoremove);
+
+/******************************************************************************/
+/*********** WorkWithlistofcoupled.c **********************************************/
+/******************************************************************************/
+extern int variscoupled_0(const char *ident) ;
+extern const char * getcoupledname_0(const char *ident);
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LEX/fortran.lex
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LEX/fortran.lex	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LEX/fortran.lex	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LEX/fortran.y
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LEX/fortran.y	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LEX/fortran.y	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/DiversListe.c
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/DiversListe.c	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/DiversListe.c	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile	(revision 6440)
@@ -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: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile.lex
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile.lex	(revision 6439)
+++ 	(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: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile.lex.byacc
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile.lex.byacc	(revision 6439)
+++ 	(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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/SubLoopCreation.c
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/SubLoopCreation.c	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/SubLoopCreation.c	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilAgrif.c
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilAgrif.c	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilAgrif.c	(revision 6440)
@@ -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,14 @@
      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");
+       {
+        if( strcasecmp(subroutinename,"Agrif_InvLoc") )	 
+       fprintf(fileout,"\n      USE Agrif_Util \n");
+       else fprintf(fileout,"\n      USE Agrif_Types \n");
+
+       }
   }
 }
@@ -419,7 +285,7 @@
 void  AddUseAgrifUtilBeforeCall_0(FILE *fileout)
 {
-  listusemodule *parcours;
-
-  int out;
+    listusemodule *parcours;
+
+    int out;
 
   if ( firstpass == 0 )
@@ -437,5 +303,7 @@
      if ( out == 0 )
      {
-        fprintf(fileout,"\n      USE Agrif_Util \n");
+       if( strcasecmp(subroutinename,"Agrif_InitWorkspace") )	 
+       fprintf(fileout,"\n      USE Agrif_Util \n");
+       else fprintf(fileout,"\n      USE Agrif_Types \n");
      }
   }
@@ -451,164 +319,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 +489,8 @@
 /*                                                                            */
 /******************************************************************************/
-void ModifyTheAgrifFunction_0(char *ident)
+void ModifyTheAgrifFunction_0(const char *ident)
 {
    if ( InAgrifParentDef != 0 )
           AgriffunctionModify_0(ident,InAgrifParentDef);
-   /*                                                                         */
    InAgrifParentDef = 0;
 }
@@ -700,240 +566,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 +800,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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilCharacter.c
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilCharacter.c	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilCharacter.c	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFile.c
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFile.c	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFile.c	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFortran.c
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFortran.c	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFortran.c	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilListe.c
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilListe.c	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilListe.c	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilNotGridDep.c
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilNotGridDep.c	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilNotGridDep.c	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithAllocatelist.c
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithAllocatelist.c	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithAllocatelist.c	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithParameterlist.c
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithParameterlist.c	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithParameterlist.c	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithglobliste.c
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithglobliste.c	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithglobliste.c	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistdatavariable.c
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistdatavariable.c	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistdatavariable.c	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistmoduleinfile.c
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistmoduleinfile.c	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistmoduleinfile.c	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistofcoupled.c
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistofcoupled.c	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistofcoupled.c	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistofmodulebysubroutine.c
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistofmodulebysubroutine.c	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistofmodulebysubroutine.c	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistvarindoloop.c
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistvarindoloop.c	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistvarindoloop.c	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithvarofsubroutineliste.c
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithvarofsubroutineliste.c	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithvarofsubroutineliste.c	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/WriteInFile.c
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/WriteInFile.c	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/WriteInFile.c	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/Writedeclarations.c
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/Writedeclarations.c	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/Writedeclarations.c	(revision 6440)
@@ -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: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/convert.lex
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/convert.lex	(revision 6439)
+++ 	(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: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/convert.y
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/convert.y	(revision 6439)
+++ 	(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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/decl.h
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/decl.h	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/decl.h	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/dependfile.c
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/dependfile.c	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/dependfile.c	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.c
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.c	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.c	(revision 6440)
@@ -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: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.lex
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.lex	(revision 6439)
+++ 	(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: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.tab.c
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.tab.c	(revision 6439)
+++ 	(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: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.y
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.y	(revision 6439)
+++ 	(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: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.yy.c
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.yy.c	(revision 6439)
+++ 	(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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/main.c
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/main.c	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/main.c	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/run
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/run	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/run	(revision 6440)
@@ -1,2 +1,2 @@
-gmake -f Makefile.lex clean
-gmake -f Makefile.lex
+make -f Makefile.lex clean
+make -f Makefile.lex
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/toamr.c
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/toamr.c	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/LIB/toamr.c	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/nemo_mpi.h
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/nemo_mpi.h	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/EXTERNAL/AGRIF/nemo_mpi.h	(revision 6440)
@@ -0,0 +1,3 @@
+#if defined key_mpp_mpi
+#define AGRIF_MPI
+#endif
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_2/limistate_2.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_2/limistate_2.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_2/limistate_2.F90	(revision 6440)
@@ -69,5 +69,6 @@
       IF( .NOT. ln_limini ) THEN  
          
-         tfu(:,:) = eos_fzp( tsn(:,:,1,jp_sal) ) * tmask(:,:,1)       ! freezing/melting point of sea water [Celcius]
+         CALL eos_fzp( tsn(:,:,1,jp_sal), tfu(:,:) )       ! freezing/melting point of sea water [Celcius]
+         tfu(:,:) = tfu(:,:) *  tmask(:,:,1)
 
          DO jj = 1, jpj
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/ice.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/ice.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/ice.F90	(revision 6440)
@@ -253,20 +253,20 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhld        !: heat flux from the lead used for bottom melting
 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw    !: snow-ocean mass exchange over 1 time step [kg/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_spr    !: snow precipitation on ice over 1 time step [kg/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sub    !: snow sublimation over 1 time step [kg/m2]
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_ice    !: ice-ocean mass exchange over 1 time step [kg/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sni    !: snow ice growth component of wfx_ice [kg/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_opw    !: lateral ice growth component of wfx_ice [kg/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bog    !: bottom ice growth component of wfx_ice [kg/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_dyn    !: dynamical ice growth component of wfx_ice [kg/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bom    !: bottom melt component of wfx_ice [kg/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sum    !: surface melt component of wfx_ice [kg/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_res    !: residual component of wfx_ice [kg/m2]
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_tot     !: ice concentration tendency (total) [s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw    !: snow-ocean mass exchange   [kg.m-2.s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_spr    !: snow precipitation on ice  [kg.m-2.s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sub    !: snow/ice sublimation       [kg.m-2.s-1]
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_ice    !: ice-ocean mass exchange                   [kg.m-2.s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sni    !: snow ice growth component of wfx_ice      [kg.m-2.s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_opw    !: lateral ice growth component of wfx_ice   [kg.m-2.s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bog    !: bottom ice growth component of wfx_ice    [kg.m-2.s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_dyn    !: dynamical ice growth component of wfx_ice [kg.m-2.s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bom    !: bottom melt component of wfx_ice          [kg.m-2.s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sum    !: surface melt component of wfx_ice         [kg.m-2.s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_res    !: residual component of wfx_ice             [kg.m-2.s-1]
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_tot     !: ice concentration tendency (total)          [s-1]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_thd     !: ice concentration tendency (thermodynamics) [s-1]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_dyn     !: ice concentration tendency (dynamics) [s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_dyn     !: ice concentration tendency (dynamics)       [s-1]
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bog     !: salt flux due to ice growth/melt                      [PSU/m2/s]
@@ -279,26 +279,30 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_res     !: residual salt flux due to correction of ice thickness [PSU/m2/s]
 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_bog     !: total heat flux causing bottom ice growth 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_bom     !: total heat flux causing bottom ice melt 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_sum     !: total heat flux causing surface ice melt 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_opw     !: total heat flux causing open water ice formation
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_dif     !: total heat flux causing Temp change in the ice 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_snw     !: heat flux for snow melt 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err     !: heat flux error after heat diffusion 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_dif !: heat flux remaining due to change in non-solar flux
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_rem !: heat flux error after heat remapping 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_in      !: heat flux available for thermo transformations 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_out     !: heat flux remaining at the end of thermo transformations 
-
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_sub     !: salt flux due to ice sublimation
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_bog     !: total heat flux causing bottom ice growth        [W.m-2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_bom     !: total heat flux causing bottom ice melt          [W.m-2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_sum     !: total heat flux causing surface ice melt         [W.m-2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_opw     !: total heat flux causing open water ice formation [W.m-2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_dif     !: total heat flux causing Temp change in the ice   [W.m-2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_snw     !: heat flux for snow melt                          [W.m-2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err     !: heat flux error after heat diffusion             [W.m-2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_dif !: heat flux remaining due to change in non-solar flux [W.m-2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_rem !: heat flux error after heat remapping             [W.m-2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_in      !: heat flux available for thermo transformations   [W.m-2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_out     !: heat flux remaining at the end of thermo transformations  [W.m-2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_err_sub !: mass flux error after sublimation [kg.m-2.s-1]
+   
    ! heat flux associated with ice-atmosphere mass exchange
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_sub     !: heat flux for sublimation 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_spr     !: heat flux of the snow precipitation 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_sub     !: heat flux for sublimation  [W.m-2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_spr     !: heat flux of the snow precipitation  [W.m-2]
 
    ! heat flux associated with ice-ocean mass exchange
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_thd     !: ice-ocean heat flux from thermo processes (limthd_dh) 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_dyn     !: ice-ocean heat flux from mecanical processes (limitd_me) 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_res     !: residual heat flux due to correction of ice thickness
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_thd     !: ice-ocean heat flux from thermo processes (limthd_dh)  [W.m-2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_dyn     !: ice-ocean heat flux from mecanical processes (limitd_me)  [W.m-2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_res     !: residual heat flux due to correction of ice thickness [W.m-2]
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ftr_ice   !: transmitted solar radiation under ice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rn_amax_2d  !: maximum ice concentration 2d array
 
    !!--------------------------------------------------------------------------
@@ -372,11 +376,12 @@
    INTEGER          , PUBLIC ::   nlay_i          !: number of ice  layers 
    INTEGER          , PUBLIC ::   nlay_s          !: number of snow layers 
-   CHARACTER(len=32), PUBLIC ::   cn_icerst_in    !: suffix of ice restart name (input)
+   CHARACTER(len=80), PUBLIC ::   cn_icerst_in    !: suffix of ice restart name (input)
    CHARACTER(len=256), PUBLIC ::   cn_icerst_indir !: ice restart input directory
-   CHARACTER(len=32), PUBLIC ::   cn_icerst_out   !: suffix of ice restart name (output)
+   CHARACTER(len=80), PUBLIC ::   cn_icerst_out   !: suffix of ice restart name (output)
    CHARACTER(len=256), PUBLIC ::   cn_icerst_outdir!: ice restart output directory
    LOGICAL          , PUBLIC ::   ln_limdyn       !: flag for ice dynamics (T) or not (F)
    LOGICAL          , PUBLIC ::   ln_icectl       !: flag for sea-ice points output (T) or not (F)
-   REAL(wp)         , PUBLIC ::   rn_amax         !: maximum ice concentration
+   REAL(wp)         , PUBLIC ::   rn_amax_n       !: maximum ice concentration Northern hemisphere
+   REAL(wp)         , PUBLIC ::   rn_amax_s       !: maximum ice concentration Southern hemisphere
    INTEGER          , PUBLIC ::   iiceprt         !: debug i-point
    INTEGER          , PUBLIC ::   jiceprt         !: debug j-point
@@ -438,8 +443,9 @@
          &      afx_tot(jpi,jpj) , afx_thd(jpi,jpj),  afx_dyn(jpi,jpj) ,                        &
          &      fhtur  (jpi,jpj) , ftr_ice(jpi,jpj,jpl), qlead  (jpi,jpj) ,                     &
-         &      sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) ,                        &
+         &      rn_amax_2d(jpi,jpj),                                                            &
+         &      sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) , sfx_sub(jpi,jpj) ,                       &
          &      sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) ,    &
          &      hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj) ,     & 
-         &      hfx_err_dif(jpi,jpj) , hfx_err_rem(jpi,jpj) ,                                   &
+         &      hfx_err_dif(jpi,jpj) , hfx_err_rem(jpi,jpj) , wfx_err_sub(jpi,jpj) ,       &
          &      hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld(jpi,jpj) ,                           &
          &      hfx_sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) , hfx_opw(jpi,jpj) ,    &
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90	(revision 6440)
@@ -24,5 +24,6 @@
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
    USE sbc_oce , ONLY : sfx  ! Surface boundary condition: ocean fields
-
+   USE sbc_ice , ONLY : qevap_ice
+   
    IMPLICIT NONE
    PRIVATE
@@ -184,5 +185,5 @@
          ! salt flux
          zfs_b  = glob_sum(  ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  &
-            &                  sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:)                                  &
+            &                  sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:)                   &
             &                ) *  e12t(:,:) * tmask(:,:,1) * zconv )
 
@@ -209,5 +210,5 @@
          ! salt flux
          zfs  = glob_sum(  ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  &
-            &                sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:)                                  & 
+            &                sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:)                   & 
             &              ) * e12t(:,:) * tmask(:,:,1) * zconv ) - zfs_b
 
@@ -256,5 +257,6 @@
             ENDIF
             IF (     zvmin   < -epsi10 ) WRITE(numout,*) 'violation v_i<0  [m]          (',cd_routine,') = ',zvmin
-            IF (     zamax   > rn_amax+epsi10 .AND. cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' ) THEN
+            IF (     zamax   > MAX( rn_amax_n, rn_amax_s ) + epsi10 .AND. &
+               &                         cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' ) THEN
                                          WRITE(numout,*) 'violation a_i>amax            (',cd_routine,') = ',zamax
             ENDIF
@@ -286,5 +288,6 @@
 #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 - SUM( qevap_ice * a_i_b, dim=3 ) )  &
+         &              * e12t * tmask(:,:,1) * zconv ) 
       ! salt flux
       zsfx  = glob_sum( ( sfx + diag_smvi ) * e12t * tmask(:,:,1) * zconv ) * rday
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90	(revision 6440)
@@ -56,5 +56,5 @@
       real(wp)   ::   zbg_ivo, zbg_svo, zbg_are, zbg_sal ,zbg_tem ,zbg_ihc ,zbg_shc
       real(wp)   ::   zbg_sfx, zbg_sfx_bri, zbg_sfx_bog, zbg_sfx_bom, zbg_sfx_sum, zbg_sfx_sni,   &
-      &               zbg_sfx_opw, zbg_sfx_res, zbg_sfx_dyn 
+      &               zbg_sfx_opw, zbg_sfx_res, zbg_sfx_dyn, zbg_sfx_sub 
       real(wp)   ::   zbg_vfx, zbg_vfx_bog, zbg_vfx_opw, zbg_vfx_sni, zbg_vfx_dyn
       real(wp)   ::   zbg_vfx_bom, zbg_vfx_sum, zbg_vfx_res, zbg_vfx_spr, zbg_vfx_snw, zbg_vfx_sub  
@@ -111,4 +111,5 @@
       zbg_sfx_bom = ztmp * glob_sum( sfx_bom(:,:) * e12t(:,:) * tmask(:,:,1) )
       zbg_sfx_sum = ztmp * glob_sum( sfx_sum(:,:) * e12t(:,:) * tmask(:,:,1) )
+      zbg_sfx_sub = ztmp * glob_sum( sfx_sub(:,:) * e12t(:,:) * tmask(:,:,1) )
 
       ! Heat budget
@@ -189,4 +190,5 @@
       CALL iom_put( 'ibgsfxbom' , zbg_sfx_bom                              )   ! salt flux bottom melt       -
       CALL iom_put( 'ibgsfxsum' , zbg_sfx_sum                              )   ! salt flux surface melt      -
+      CALL iom_put( 'ibgsfxsub' , zbg_sfx_sub                              )   ! salt flux sublimation      -
 
       CALL iom_put( 'ibghfxdhc' , zbg_hfx_dhc                              )   ! Heat content variation in snow and ice [W]
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90	(revision 6440)
@@ -117,5 +117,6 @@
 
       ! basal temperature (considered at freezing point)
-      t_bo(:,:) = ( eos_fzp( sss_m(:,:) ) + rt0 ) * tmask(:,:,1) 
+      CALL eos_fzp( sss_m(:,:), t_bo(:,:) )
+      t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) 
 
       IF( ln_iceini ) THEN
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90	(revision 6440)
@@ -45,26 +45,17 @@
    REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   asum     ! sum of total ice and open water area
    REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   aksum    ! ratio of area removed to area ridged
-   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   athorn   ! participation function; fraction of ridging/
-   !                                                     ! closing associated w/ category n
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   athorn   ! participation function; fraction of ridging/closing associated w/ category n
    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   hrmin    ! minimum ridge thickness
    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   hrmax    ! maximum ridge thickness
    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   hraft    ! thickness of rafted ice
-   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   krdg     ! mean ridge thickness/thickness of ridging ice 
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   krdg     ! thickness of ridging ice / mean ridge thickness
    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   aridge   ! participating ice ridging
    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   araft    ! participating ice rafting
 
    REAL(wp), PARAMETER ::   krdgmin = 1.1_wp    ! min ridge thickness multiplier
-   REAL(wp), PARAMETER ::   kraft   = 2.0_wp    ! rafting multipliyer
-   REAL(wp), PARAMETER ::   kamax   = 1.0_wp    ! max of ice area authorized (clem: scheme is not stable if kamax <= 0.99)
+   REAL(wp), PARAMETER ::   kraft   = 0.5_wp    ! rafting multipliyer
 
    REAL(wp) ::   Cp                             ! 
    !
-   !-----------------------------------------------------------------------
-   ! Ridging diagnostic arrays for history files
-   !-----------------------------------------------------------------------
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dardg1dt   ! rate of fractional area loss by ridging ice (1/s)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dardg2dt   ! rate of fractional area gain by new ridges (1/s)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dvirdgdt   ! rate of ice volume ridged (m/s)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   opening    ! rate of opening due to divergence/shear (1/s)
    !
    !!----------------------------------------------------------------------
@@ -83,11 +74,6 @@
          &      asum (jpi,jpj)     , athorn(jpi,jpj,0:jpl)                    ,     &
          &      aksum(jpi,jpj)                                                ,     &
-         !
          &      hrmin(jpi,jpj,jpl) , hraft(jpi,jpj,jpl) , aridge(jpi,jpj,jpl) ,     &
-         &      hrmax(jpi,jpj,jpl) , krdg (jpi,jpj,jpl) , araft (jpi,jpj,jpl) ,     &
-         !
-         !* Ridging diagnostic arrays for history files
-         &      dardg1dt(jpi,jpj)  , dardg2dt(jpi,jpj)                        ,     & 
-         &      dvirdgdt(jpi,jpj)  , opening(jpi,jpj)                         , STAT=lim_itd_me_alloc )
+         &      hrmax(jpi,jpj,jpl) , krdg (jpi,jpj,jpl) , araft (jpi,jpj,jpl) , STAT=lim_itd_me_alloc )
          !
       IF( lim_itd_me_alloc /= 0 )   CALL ctl_warn( 'lim_itd_me_alloc: failed to allocate arrays' )
@@ -132,7 +118,4 @@
       REAL(wp), POINTER, DIMENSION(:,:)   ::   opning          ! rate of opening due to divergence/shear
       REAL(wp), POINTER, DIMENSION(:,:)   ::   closing_gross   ! rate at which area removed, not counting area of new ridges
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   msnow_mlt       ! mass of snow added to ocean (kg m-2)
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   esnow_mlt       ! energy needed to melt snow in ocean (J m-2)
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   vt_i_init, vt_i_final  !  ice volume summed over categories
       !
       INTEGER, PARAMETER ::   nitermax = 20    
@@ -142,5 +125,5 @@
       IF( nn_timing == 1 )  CALL timing_start('limitd_me')
 
-      CALL wrk_alloc( jpi,jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final )
+      CALL wrk_alloc( jpi,jpj, closing_net, divu_adv, opning, closing_gross )
 
       IF(ln_ctl) THEN
@@ -154,7 +137,4 @@
       IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
 
-      CALL lim_var_zapsmall
-      CALL lim_var_glo2eqv            ! equivalent variables, requested for rafting
-
       !-----------------------------------------------------------------------------!
       ! 1) Thickness categories boundaries, ice / o.w. concentrations, init_ons
@@ -164,14 +144,7 @@
       CALL lim_itd_me_ridgeprep                                    ! prepare ridging
       !
-      IF( con_i)   CALL lim_column_sum( jpl, v_i, vt_i_init )      ! conservation check
 
       DO jj = 1, jpj                                     ! Initialize arrays.
          DO ji = 1, jpi
-            msnow_mlt(ji,jj) = 0._wp
-            esnow_mlt(ji,jj) = 0._wp
-            dardg1dt (ji,jj) = 0._wp
-            dardg2dt (ji,jj) = 0._wp
-            dvirdgdt (ji,jj) = 0._wp
-            opening  (ji,jj) = 0._wp
 
             !-----------------------------------------------------------------------------!
@@ -204,6 +177,6 @@
             ! If divu_adv < 0, make sure the closing rate is large enough
             ! to give asum = 1.0 after ridging.
-
-            divu_adv(ji,jj) = ( kamax - asum(ji,jj) ) * r1_rdtice  ! asum found in ridgeprep
+            
+            divu_adv(ji,jj) = ( 1._wp - asum(ji,jj) ) * r1_rdtice  ! asum found in ridgeprep
 
             IF( divu_adv(ji,jj) < 0._wp )   closing_net(ji,jj) = MAX( closing_net(ji,jj), -divu_adv(ji,jj) )
@@ -224,25 +197,25 @@
       DO WHILE ( iterate_ridging > 0 .AND. niter < nitermax )
 
+         ! 3.2 closing_gross
+         !-----------------------------------------------------------------------------!
+         ! Based on the ITD of ridging and ridged ice, convert the net
+         !  closing rate to a gross closing rate.  
+         ! NOTE: 0 < aksum <= 1
+         closing_gross(:,:) = closing_net(:,:) / aksum(:,:)
+
+         ! correction to closing rate and opening if closing rate is excessive
+         !---------------------------------------------------------------------
+         ! Reduce the closing rate if more than 100% of the open water 
+         ! would be removed.  Reduce the opening rate proportionately.
          DO jj = 1, jpj
             DO ji = 1, jpi
-
-               ! 3.2 closing_gross
-               !-----------------------------------------------------------------------------!
-               ! Based on the ITD of ridging and ridged ice, convert the net
-               !  closing rate to a gross closing rate.  
-               ! NOTE: 0 < aksum <= 1
-               closing_gross(ji,jj) = closing_net(ji,jj) / aksum(ji,jj)
-
-               ! correction to closing rate and opening if closing rate is excessive
-               !---------------------------------------------------------------------
-               ! Reduce the closing rate if more than 100% of the open water 
-               ! would be removed.  Reduce the opening rate proportionately.
-               za   = athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice
-               IF( za > epsi20 ) THEN
-                  zfac = MIN( 1._wp, ato_i(ji,jj) / za )
-                  closing_gross(ji,jj) = closing_gross(ji,jj) * zfac
-                  opning       (ji,jj) = opning       (ji,jj) * zfac
+               za   = ( opning(ji,jj) - athorn(ji,jj,0) * closing_gross(ji,jj) ) * rdt_ice
+               IF( za < 0._wp .AND. za > - ato_i(ji,jj) ) THEN  ! would lead to negative ato_i
+                  zfac = - ato_i(ji,jj) / za
+                  opning(ji,jj) = athorn(ji,jj,0) * closing_gross(ji,jj) - ato_i(ji,jj) * r1_rdtice 
+               ELSEIF( za > 0._wp .AND. za > ( asum(ji,jj) - ato_i(ji,jj) ) ) THEN  ! would lead to ato_i > asum
+                  zfac = ( asum(ji,jj) - ato_i(ji,jj) ) / za
+                  opning(ji,jj) = athorn(ji,jj,0) * closing_gross(ji,jj) + ( asum(ji,jj) - ato_i(ji,jj) ) * r1_rdtice 
                ENDIF
-
             END DO
          END DO
@@ -256,8 +229,7 @@
                DO ji = 1, jpi
                   za = athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice
-                  IF( za  >  epsi20 ) THEN
-                     zfac = MIN( 1._wp, a_i(ji,jj,jl) / za )
+                  IF( za  >  a_i(ji,jj,jl) ) THEN
+                     zfac = a_i(ji,jj,jl) / za
                      closing_gross(ji,jj) = closing_gross(ji,jj) * zfac
-                     opning       (ji,jj) = opning       (ji,jj) * zfac
                   ENDIF
                END DO
@@ -268,13 +240,11 @@
          !-----------------------------------------------------------------------------!
 
-         CALL lim_itd_me_ridgeshift( opning, closing_gross, msnow_mlt, esnow_mlt )
-
+         CALL lim_itd_me_ridgeshift( opning, closing_gross )
+
+         
          ! 3.4 Compute total area of ice plus open water after ridging.
          !-----------------------------------------------------------------------------!
          ! This is in general not equal to one because of divergence during transport
-         asum(:,:) = ato_i(:,:)
-         DO jl = 1, jpl
-            asum(:,:) = asum(:,:) + a_i(:,:,jl)
-         END DO
+         asum(:,:) = ato_i(:,:) + SUM( a_i, dim=3 )
 
          ! 3.5 Do we keep on iterating ???
@@ -284,13 +254,12 @@
 
          iterate_ridging = 0
-
          DO jj = 1, jpj
             DO ji = 1, jpi
-               IF (ABS(asum(ji,jj) - kamax ) < epsi10) THEN
+               IF( ABS( asum(ji,jj) - 1._wp ) < epsi10 ) THEN
                   closing_net(ji,jj) = 0._wp
                   opning     (ji,jj) = 0._wp
                ELSE
                   iterate_ridging    = 1
-                  divu_adv   (ji,jj) = ( kamax - asum(ji,jj) ) * r1_rdtice
+                  divu_adv   (ji,jj) = ( 1._wp - asum(ji,jj) ) * r1_rdtice
                   closing_net(ji,jj) = MAX( 0._wp, -divu_adv(ji,jj) )
                   opning     (ji,jj) = MAX( 0._wp,  divu_adv(ji,jj) )
@@ -309,60 +278,12 @@
 
          IF( iterate_ridging == 1 ) THEN
+            CALL lim_itd_me_ridgeprep
             IF( niter  >  nitermax ) THEN
                WRITE(numout,*) ' ALERTE : non-converging ridging scheme '
                WRITE(numout,*) ' niter, iterate_ridging ', niter, iterate_ridging
             ENDIF
-            CALL lim_itd_me_ridgeprep
          ENDIF
 
       END DO !! on the do while over iter
-
-      !-----------------------------------------------------------------------------!
-      ! 4) Ridging diagnostics
-      !-----------------------------------------------------------------------------!
-      ! Convert ridging rate diagnostics to correct units.
-      ! Update fresh water and heat fluxes due to snow melt.
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-
-            dardg1dt(ji,jj) = dardg1dt(ji,jj) * r1_rdtice
-            dardg2dt(ji,jj) = dardg2dt(ji,jj) * r1_rdtice
-            dvirdgdt(ji,jj) = dvirdgdt(ji,jj) * r1_rdtice
-            opening (ji,jj) = opening (ji,jj) * r1_rdtice
-
-            !-----------------------------------------------------------------------------!
-            ! 5) Heat, salt and freshwater fluxes
-            !-----------------------------------------------------------------------------!
-            wfx_snw(ji,jj) = wfx_snw(ji,jj) + msnow_mlt(ji,jj) * r1_rdtice     ! fresh water source for ocean
-            hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + esnow_mlt(ji,jj) * r1_rdtice     ! heat sink for ocean (<0, W.m-2)
-
-         END DO
-      END DO
-
-      ! Check if there is a ridging error
-      IF( lwp ) THEN
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( ABS( asum(ji,jj) - kamax)  >  epsi10 ) THEN   ! there is a bug
-                  WRITE(numout,*) ' '
-                  WRITE(numout,*) ' ALERTE : Ridging error: total area = ', asum(ji,jj)
-                  WRITE(numout,*) ' limitd_me '
-                  WRITE(numout,*) ' POINT : ', ji, jj
-                  WRITE(numout,*) ' jpl, a_i, athorn '
-                  WRITE(numout,*) 0, ato_i(ji,jj), athorn(ji,jj,0)
-                  DO jl = 1, jpl
-                     WRITE(numout,*) jl, a_i(ji,jj,jl), athorn(ji,jj,jl)
-                  END DO
-               ENDIF
-            END DO
-         END DO
-      END IF
-
-      ! Conservation check
-      IF ( con_i ) THEN
-         CALL lim_column_sum (jpl,   v_i, vt_i_final)
-         fieldid = ' v_i : limitd_me '
-         CALL lim_cons_check (vt_i_init, vt_i_final, 1.0e-6, fieldid) 
-      ENDIF
 
       CALL lim_var_agg( 1 ) 
@@ -410,9 +331,441 @@
       ENDIF  ! ln_limdyn=.true.
       !
-      CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final )
+      CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross )
       !
       IF( nn_timing == 1 )  CALL timing_stop('limitd_me')
    END SUBROUTINE lim_itd_me
 
+   SUBROUTINE lim_itd_me_ridgeprep
+      !!---------------------------------------------------------------------!
+      !!                ***  ROUTINE lim_itd_me_ridgeprep ***
+      !!
+      !! ** Purpose :   preparation for ridging and strength calculations
+      !!
+      !! ** Method  :   Compute the thickness distribution of the ice and open water 
+      !!              participating in ridging and of the resulting ridges.
+      !!---------------------------------------------------------------------!
+      INTEGER ::   ji,jj, jl    ! dummy loop indices
+      REAL(wp) ::   Gstari, astari, hrmean, zdummy   ! local scalar
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   Gsum      ! Gsum(n) = sum of areas in categories 0 to n
+      !------------------------------------------------------------------------------!
+
+      CALL wrk_alloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 )
+
+      Gstari     = 1.0/rn_gstar    
+      astari     = 1.0/rn_astar    
+      aksum(:,:)    = 0.0
+      athorn(:,:,:) = 0.0
+      aridge(:,:,:) = 0.0
+      araft (:,:,:) = 0.0
+
+      ! Zero out categories with very small areas
+      CALL lim_var_zapsmall
+
+      ! Ice thickness needed for rafting
+      DO jl = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) )
+               ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
+            END DO
+         END DO
+      END DO
+
+      !------------------------------------------------------------------------------!
+      ! 1) Participation function 
+      !------------------------------------------------------------------------------!
+
+      ! Compute total area of ice plus open water.
+      ! This is in general not equal to one because of divergence during transport
+      asum(:,:) = ato_i(:,:) + SUM( a_i, dim=3 )
+
+      ! Compute cumulative thickness distribution function
+      ! Compute the cumulative thickness distribution function Gsum,
+      ! where Gsum(n) is the fractional area in categories 0 to n.
+      ! initial value (in h = 0) equals open water area
+      Gsum(:,:,-1) = 0._wp
+      Gsum(:,:,0 ) = ato_i(:,:)
+      ! for each value of h, you have to add ice concentration then
+      DO jl = 1, jpl
+         Gsum(:,:,jl) = Gsum(:,:,jl-1) + a_i(:,:,jl)
+      END DO
+
+      ! Normalize the cumulative distribution to 1
+      DO jl = 0, jpl
+         Gsum(:,:,jl) = Gsum(:,:,jl) / asum(:,:)
+      END DO
+
+      ! 1.3 Compute participation function a(h) = b(h).g(h) (athorn)
+      !--------------------------------------------------------------------------------------------------
+      ! Compute the participation function athorn; this is analogous to
+      ! a(h) = b(h)g(h) as defined in Thorndike et al. (1975).
+      ! area lost from category n due to ridging/closing
+      ! athorn(n)   = total area lost due to ridging/closing
+      ! assume b(h) = (2/Gstar) * (1 - G(h)/Gstar). 
+      !
+      ! The expressions for athorn are found by integrating b(h)g(h) between
+      ! the category boundaries.
+      ! athorn is always >= 0 and SUM(athorn(0:jpl))=1
+      !-----------------------------------------------------------------
+
+      IF( nn_partfun == 0 ) THEN       !--- Linear formulation (Thorndike et al., 1975)
+         DO jl = 0, jpl    
+            DO jj = 1, jpj 
+               DO ji = 1, jpi
+                  IF    ( Gsum(ji,jj,jl)   < rn_gstar ) THEN
+                     athorn(ji,jj,jl) = Gstari * ( Gsum(ji,jj,jl) - Gsum(ji,jj,jl-1) ) * &
+                        &                        ( 2._wp - ( Gsum(ji,jj,jl-1) + Gsum(ji,jj,jl) ) * Gstari )
+                  ELSEIF( Gsum(ji,jj,jl-1) < rn_gstar ) THEN
+                     athorn(ji,jj,jl) = Gstari * ( rn_gstar       - Gsum(ji,jj,jl-1) ) *  &
+                        &                        ( 2._wp - ( Gsum(ji,jj,jl-1) + rn_gstar       ) * Gstari )
+                  ELSE
+                     athorn(ji,jj,jl) = 0._wp
+                  ENDIF
+               END DO
+            END DO
+         END DO
+
+      ELSE                             !--- Exponential, more stable formulation (Lipscomb et al, 2007)
+         !                        
+         zdummy = 1._wp / ( 1._wp - EXP(-astari) )        ! precompute exponential terms using Gsum as a work array
+         DO jl = -1, jpl
+            Gsum(:,:,jl) = EXP( -Gsum(:,:,jl) * astari ) * zdummy
+         END DO
+         DO jl = 0, jpl
+             athorn(:,:,jl) = Gsum(:,:,jl-1) - Gsum(:,:,jl)
+         END DO
+         !
+      ENDIF
+
+      IF( ln_rafting ) THEN      ! Ridging and rafting ice participation functions
+         !
+         DO jl = 1, jpl
+            DO jj = 1, jpj 
+               DO ji = 1, jpi
+                  zdummy           = TANH ( rn_craft * ( ht_i(ji,jj,jl) - rn_hraft ) )
+                  aridge(ji,jj,jl) = ( 1._wp + zdummy ) * 0.5_wp * athorn(ji,jj,jl)
+                  araft (ji,jj,jl) = ( 1._wp - zdummy ) * 0.5_wp * athorn(ji,jj,jl)
+               END DO
+            END DO
+         END DO
+
+      ELSE
+         !
+         DO jl = 1, jpl
+            aridge(:,:,jl) = athorn(:,:,jl)
+         END DO
+         !
+      ENDIF
+
+      !-----------------------------------------------------------------
+      ! 2) Transfer function
+      !-----------------------------------------------------------------
+      ! Compute max and min ridged ice thickness for each ridging category.
+      ! Assume ridged ice is uniformly distributed between hrmin and hrmax.
+      ! 
+      ! This parameterization is a modified version of Hibler (1980).
+      ! The mean ridging thickness, hrmean, is proportional to hi^(0.5)
+      !  and for very thick ridging ice must be >= krdgmin*hi
+      !
+      ! The minimum ridging thickness, hrmin, is equal to 2*hi 
+      !  (i.e., rafting) and for very thick ridging ice is
+      !  constrained by hrmin <= (hrmean + hi)/2.
+      ! 
+      ! The maximum ridging thickness, hrmax, is determined by
+      !  hrmean and hrmin.
+      !
+      ! These modifications have the effect of reducing the ice strength
+      ! (relative to the Hibler formulation) when very thick ice is
+      ! ridging.
+      !
+      ! aksum = net area removed/ total area removed
+      ! where total area removed = area of ice that ridges
+      !         net area removed = total area removed - area of new ridges
+      !-----------------------------------------------------------------
+
+      aksum(:,:) = athorn(:,:,0)
+      ! Transfer function
+      DO jl = 1, jpl !all categories have a specific transfer function
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               
+               IF( athorn(ji,jj,jl) > 0._wp ) THEN
+                  hrmean          = MAX( SQRT( rn_hstar * ht_i(ji,jj,jl) ), ht_i(ji,jj,jl) * krdgmin )
+                  hrmin(ji,jj,jl) = MIN( 2._wp * ht_i(ji,jj,jl), 0.5_wp * ( hrmean + ht_i(ji,jj,jl) ) )
+                  hrmax(ji,jj,jl) = 2._wp * hrmean - hrmin(ji,jj,jl)
+                  hraft(ji,jj,jl) = ht_i(ji,jj,jl) / kraft
+                  krdg(ji,jj,jl)  = ht_i(ji,jj,jl) / MAX( hrmean, epsi20 )
+
+                  ! Normalization factor : aksum, ensures mass conservation
+                  aksum(ji,jj) = aksum(ji,jj) + aridge(ji,jj,jl) * ( 1._wp - krdg(ji,jj,jl) )    &
+                     &                        + araft (ji,jj,jl) * ( 1._wp - kraft          )
+
+               ELSE
+                  hrmin(ji,jj,jl)  = 0._wp 
+                  hrmax(ji,jj,jl)  = 0._wp 
+                  hraft(ji,jj,jl)  = 0._wp 
+                  krdg (ji,jj,jl)  = 1._wp
+               ENDIF
+
+            END DO
+         END DO
+      END DO
+      !
+      CALL wrk_dealloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 )
+      !
+   END SUBROUTINE lim_itd_me_ridgeprep
+
+
+   SUBROUTINE lim_itd_me_ridgeshift( opning, closing_gross )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE lim_itd_me_icestrength ***
+      !!
+      !! ** Purpose :   shift ridging ice among thickness categories of ice thickness
+      !!
+      !! ** Method  :   Remove area, volume, and energy from each ridging category
+      !!              and add to thicker ice categories.
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   opning         ! rate of opening due to divergence/shear
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   closing_gross  ! rate at which area removed, excluding area of new ridges
+      !
+      CHARACTER (len=80) ::   fieldid   ! field identifier
+      !
+      INTEGER ::   ji, jj, jl, jl1, jl2, jk   ! dummy loop indices
+      INTEGER ::   ij                ! horizontal index, combines i and j loops
+      INTEGER ::   icells            ! number of cells with a_i > puny
+      REAL(wp) ::   hL, hR, farea    ! left and right limits of integration
+
+      INTEGER , POINTER, DIMENSION(:) ::   indxi, indxj   ! compressed indices
+      REAL(wp), POINTER, DIMENSION(:) ::   zswitch, fvol   ! new ridge volume going to n2
+
+      REAL(wp), POINTER, DIMENSION(:) ::   afrac            ! fraction of category area ridged 
+      REAL(wp), POINTER, DIMENSION(:) ::   ardg1 , ardg2    ! area of ice ridged & new ridges
+      REAL(wp), POINTER, DIMENSION(:) ::   vsrdg , esrdg    ! snow volume & energy of ridging ice
+      REAL(wp), POINTER, DIMENSION(:) ::   dhr   , dhr2     ! hrmax - hrmin  &  hrmax^2 - hrmin^2
+
+      REAL(wp), POINTER, DIMENSION(:) ::   vrdg1   ! volume of ice ridged
+      REAL(wp), POINTER, DIMENSION(:) ::   vrdg2   ! volume of new ridges
+      REAL(wp), POINTER, DIMENSION(:) ::   vsw     ! volume of seawater trapped into ridges
+      REAL(wp), POINTER, DIMENSION(:) ::   srdg1   ! sal*volume of ice ridged
+      REAL(wp), POINTER, DIMENSION(:) ::   srdg2   ! sal*volume of new ridges
+      REAL(wp), POINTER, DIMENSION(:) ::   smsw    ! sal*volume of water trapped into ridges
+      REAL(wp), POINTER, DIMENSION(:) ::   oirdg1, oirdg2   ! ice age of ice ridged
+
+      REAL(wp), POINTER, DIMENSION(:) ::   afrft            ! fraction of category area rafted
+      REAL(wp), POINTER, DIMENSION(:) ::   arft1 , arft2    ! area of ice rafted and new rafted zone
+      REAL(wp), POINTER, DIMENSION(:) ::   virft , vsrft    ! ice & snow volume of rafting ice
+      REAL(wp), POINTER, DIMENSION(:) ::   esrft , smrft    ! snow energy & salinity of rafting ice
+      REAL(wp), POINTER, DIMENSION(:) ::   oirft1, oirft2   ! ice age of ice rafted
+
+      REAL(wp), POINTER, DIMENSION(:,:) ::   eirft      ! ice energy of rafting ice
+      REAL(wp), POINTER, DIMENSION(:,:) ::   erdg1      ! enth*volume of ice ridged
+      REAL(wp), POINTER, DIMENSION(:,:) ::   erdg2      ! enth*volume of new ridges
+      REAL(wp), POINTER, DIMENSION(:,:) ::   ersw       ! enth of water trapped into ridges
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc( jpij,        indxi, indxj )
+      CALL wrk_alloc( jpij,        zswitch, fvol )
+      CALL wrk_alloc( jpij,        afrac, ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 )
+      CALL wrk_alloc( jpij,        vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw, oirdg1, oirdg2 )
+      CALL wrk_alloc( jpij,        afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 )
+      CALL wrk_alloc( jpij,nlay_i, eirft, erdg1, erdg2, ersw )
+
+      !-------------------------------------------------------------------------------
+      ! 1) Compute change in open water area due to closing and opening.
+      !-------------------------------------------------------------------------------
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ato_i(ji,jj) = MAX( 0._wp, ato_i(ji,jj) +  &
+               &                     ( opning(ji,jj) - athorn(ji,jj,0) * closing_gross(ji,jj) ) * rdt_ice )
+         END DO
+      END DO
+
+      !-----------------------------------------------------------------
+      ! 3) Pump everything from ice which is being ridged / rafted
+      !-----------------------------------------------------------------
+      ! Compute the area, volume, and energy of ice ridging in each
+      ! category, along with the area of the resulting ridge.
+
+      DO jl1 = 1, jpl !jl1 describes the ridging category
+
+         !------------------------------------------------
+         ! 3.1) Identify grid cells with nonzero ridging
+         !------------------------------------------------
+         icells = 0
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( athorn(ji,jj,jl1) > 0._wp .AND. closing_gross(ji,jj) > 0._wp ) THEN
+                  icells = icells + 1
+                  indxi(icells) = ji
+                  indxj(icells) = jj
+               ENDIF
+            END DO
+         END DO
+
+         DO ij = 1, icells
+            ji = indxi(ij) ; jj = indxj(ij)
+
+            !--------------------------------------------------------------------
+            ! 3.2) Compute area of ridging ice (ardg1) and of new ridge (ardg2)
+            !--------------------------------------------------------------------
+            ardg1(ij) = aridge(ji,jj,jl1) * closing_gross(ji,jj) * rdt_ice
+            arft1(ij) = araft (ji,jj,jl1) * closing_gross(ji,jj) * rdt_ice
+
+            !---------------------------------------------------------------
+            ! 3.3) Compute ridging /rafting fractions, make sure afrac <=1 
+            !---------------------------------------------------------------
+            afrac(ij) = ardg1(ij) / a_i(ji,jj,jl1) !ridging
+            afrft(ij) = arft1(ij) / a_i(ji,jj,jl1) !rafting
+            ardg2(ij) = ardg1(ij) * krdg(ji,jj,jl1)
+            arft2(ij) = arft1(ij) * kraft
+
+            !--------------------------------------------------------------------------
+            ! 3.4) Subtract area, volume, and energy from ridging 
+            !     / rafting category n1.
+            !--------------------------------------------------------------------------
+            vrdg1(ij) = v_i(ji,jj,jl1) * afrac(ij)
+            vrdg2(ij) = vrdg1(ij) * ( 1. + rn_por_rdg )
+            vsw  (ij) = vrdg1(ij) * rn_por_rdg
+
+            vsrdg (ij) = v_s  (ji,jj,  jl1) * afrac(ij)
+            esrdg (ij) = e_s  (ji,jj,1,jl1) * afrac(ij)
+            srdg1 (ij) = smv_i(ji,jj,  jl1) * afrac(ij)
+            oirdg1(ij) = oa_i (ji,jj,  jl1) * afrac(ij)
+            oirdg2(ij) = oa_i (ji,jj,  jl1) * afrac(ij) * krdg(ji,jj,jl1) 
+
+            ! rafting volumes, heat contents ...
+            virft (ij) = v_i  (ji,jj,  jl1) * afrft(ij)
+            vsrft (ij) = v_s  (ji,jj,  jl1) * afrft(ij)
+            esrft (ij) = e_s  (ji,jj,1,jl1) * afrft(ij)
+            smrft (ij) = smv_i(ji,jj,  jl1) * afrft(ij) 
+            oirft1(ij) = oa_i (ji,jj,  jl1) * afrft(ij) 
+            oirft2(ij) = oa_i (ji,jj,  jl1) * afrft(ij) * kraft 
+
+            !-----------------------------------------------------------------
+            ! 3.5) Compute properties of new ridges
+            !-----------------------------------------------------------------
+            smsw(ij)  = vsw(ij) * sss_m(ji,jj)                   ! salt content of seawater frozen in voids
+            srdg2(ij) = srdg1(ij) + smsw(ij)                     ! salt content of new ridge
+            
+            sfx_dyn(ji,jj) = sfx_dyn(ji,jj) - smsw(ij) * rhoic * r1_rdtice
+            wfx_dyn(ji,jj) = wfx_dyn(ji,jj) - vsw (ij) * rhoic * r1_rdtice   ! increase in ice volume due to seawater frozen in voids
+            
+            !------------------------------------------            
+            ! 3.7 Put the snow somewhere in the ocean
+            !------------------------------------------            
+            !  Place part of the snow lost by ridging into the ocean. 
+            !  Note that esrdg > 0; the ocean must cool to melt snow.
+            !  If the ocean temp = Tf already, new ice must grow.
+            !  During the next time step, thermo_rates will determine whether
+            !  the ocean cools or new ice grows.
+            wfx_snw(ji,jj) = wfx_snw(ji,jj) + ( rhosn * vsrdg(ij) * ( 1._wp - rn_fsnowrdg )   & 
+               &                              + rhosn * vsrft(ij) * ( 1._wp - rn_fsnowrft ) ) * r1_rdtice  ! fresh water source for ocean
+
+            hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + ( - esrdg(ij) * ( 1._wp - rn_fsnowrdg )         & 
+               &                                - esrft(ij) * ( 1._wp - rn_fsnowrft ) ) * r1_rdtice        ! heat sink for ocean (<0, W.m-2)
+
+            !-----------------------------------------------------------------
+            ! 3.8 Compute quantities used to apportion ice among categories
+            ! in the n2 loop below
+            !-----------------------------------------------------------------
+            dhr (ij) = 1._wp / ( hrmax(ji,jj,jl1)                    - hrmin(ji,jj,jl1)                    )
+            dhr2(ij) = 1._wp / ( hrmax(ji,jj,jl1) * hrmax(ji,jj,jl1) - hrmin(ji,jj,jl1) * hrmin(ji,jj,jl1) )
+
+
+            ! update jl1 (removing ridged/rafted area)
+            a_i  (ji,jj,  jl1) = a_i  (ji,jj,  jl1) - ardg1 (ij) - arft1 (ij)
+            v_i  (ji,jj,  jl1) = v_i  (ji,jj,  jl1) - vrdg1 (ij) - virft (ij)
+            v_s  (ji,jj,  jl1) = v_s  (ji,jj,  jl1) - vsrdg (ij) - vsrft (ij)
+            e_s  (ji,jj,1,jl1) = e_s  (ji,jj,1,jl1) - esrdg (ij) - esrft (ij)
+            smv_i(ji,jj,  jl1) = smv_i(ji,jj,  jl1) - srdg1 (ij) - smrft (ij)
+            oa_i (ji,jj,  jl1) = oa_i (ji,jj,  jl1) - oirdg1(ij) - oirft1(ij)
+
+         END DO
+
+         !--------------------------------------------------------------------
+         ! 3.9 Compute ridging ice enthalpy, remove it from ridging ice and
+         !      compute ridged ice enthalpy 
+         !--------------------------------------------------------------------
+         DO jk = 1, nlay_i
+            DO ij = 1, icells
+               ji = indxi(ij) ; jj = indxj(ij)
+               ! heat content of ridged ice
+               erdg1(ij,jk) = e_i(ji,jj,jk,jl1) * afrac(ij) 
+               eirft(ij,jk) = e_i(ji,jj,jk,jl1) * afrft(ij)               
+               
+               ! enthalpy of the trapped seawater (J/m2, >0)
+               ! clem: if sst>0, then ersw <0 (is that possible?)
+               ersw(ij,jk)  = - rhoic * vsw(ij) * rcp * sst_m(ji,jj) * r1_nlay_i
+
+               ! heat flux to the ocean
+               hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + ersw(ij,jk) * r1_rdtice  ! > 0 [W.m-2] ocean->ice flux 
+
+               ! it is added to sea ice because the sign convention is the opposite of the sign convention for the ocean
+               erdg2(ij,jk) = erdg1(ij,jk) + ersw(ij,jk)
+
+               ! update jl1
+               e_i  (ji,jj,jk,jl1) = e_i(ji,jj,jk,jl1) - erdg1(ij,jk) - eirft(ij,jk)
+
+            END DO
+         END DO
+
+         !-------------------------------------------------------------------------------
+         ! 4) Add area, volume, and energy of new ridge to each category jl2
+         !-------------------------------------------------------------------------------
+         DO jl2  = 1, jpl 
+            ! over categories to which ridged/rafted ice is transferred
+            DO ij = 1, icells
+               ji = indxi(ij) ; jj = indxj(ij)
+
+               ! Compute the fraction of ridged ice area and volume going to thickness category jl2.
+               IF( hrmin(ji,jj,jl1) <= hi_max(jl2) .AND. hrmax(ji,jj,jl1) > hi_max(jl2-1) ) THEN
+                  hL = MAX( hrmin(ji,jj,jl1), hi_max(jl2-1) )
+                  hR = MIN( hrmax(ji,jj,jl1), hi_max(jl2)   )
+                  farea    = ( hR      - hL      ) * dhr(ij) 
+                  fvol(ij) = ( hR * hR - hL * hL ) * dhr2(ij)
+               ELSE
+                  farea    = 0._wp 
+                  fvol(ij) = 0._wp                  
+               ENDIF
+
+               ! Compute the fraction of rafted ice area and volume going to thickness category jl2
+               IF( hraft(ji,jj,jl1) <= hi_max(jl2) .AND. hraft(ji,jj,jl1) >  hi_max(jl2-1) ) THEN
+                  zswitch(ij) = 1._wp
+               ELSE
+                  zswitch(ij) = 0._wp                  
+               ENDIF
+
+               a_i  (ji,jj  ,jl2) = a_i  (ji,jj  ,jl2) + ( ardg2 (ij) * farea    + arft2 (ij) * zswitch(ij) )
+               oa_i (ji,jj  ,jl2) = oa_i (ji,jj  ,jl2) + ( oirdg2(ij) * farea    + oirft2(ij) * zswitch(ij) )
+               v_i  (ji,jj  ,jl2) = v_i  (ji,jj  ,jl2) + ( vrdg2 (ij) * fvol(ij) + virft (ij) * zswitch(ij) )
+               smv_i(ji,jj  ,jl2) = smv_i(ji,jj  ,jl2) + ( srdg2 (ij) * fvol(ij) + smrft (ij) * zswitch(ij) )
+               v_s  (ji,jj  ,jl2) = v_s  (ji,jj  ,jl2) + ( vsrdg (ij) * rn_fsnowrdg * fvol(ij)  +  &
+                  &                                        vsrft (ij) * rn_fsnowrft * zswitch(ij) )
+               e_s  (ji,jj,1,jl2) = e_s  (ji,jj,1,jl2) + ( esrdg (ij) * rn_fsnowrdg * fvol(ij)  +  &
+                  &                                        esrft (ij) * rn_fsnowrft * zswitch(ij) )
+
+            END DO
+
+            ! Transfer ice energy to category jl2 by ridging
+            DO jk = 1, nlay_i
+               DO ij = 1, icells
+                  ji = indxi(ij) ; jj = indxj(ij)
+                  e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) + erdg2(ij,jk) * fvol(ij) + eirft(ij,jk) * zswitch(ij)                  
+               END DO
+            END DO
+            !
+         END DO ! jl2
+         
+      END DO ! jl1 (deforming categories)
+
+      !
+      CALL wrk_dealloc( jpij,        indxi, indxj )
+      CALL wrk_dealloc( jpij,        zswitch, fvol )
+      CALL wrk_dealloc( jpij,        afrac, ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 )
+      CALL wrk_dealloc( jpij,        vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw, oirdg1, oirdg2 )
+      CALL wrk_dealloc( jpij,        afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 )
+      CALL wrk_dealloc( jpij,nlay_i, eirft, erdg1, erdg2, ersw )
+      !
+   END SUBROUTINE lim_itd_me_ridgeshift
 
    SUBROUTINE lim_itd_me_icestrength( kstrngth )
@@ -434,5 +787,5 @@
       INTEGER             ::   ksmooth     ! smoothing the resistance to deformation
       INTEGER             ::   numts_rm    ! number of time steps for the P smoothing
-      REAL(wp)            ::   zhi, zp, z1_3  ! local scalars
+      REAL(wp)            ::   zp, z1_3    ! local scalars
       REAL(wp), POINTER, DIMENSION(:,:) ::   zworka   ! temporary array used here
       !!----------------------------------------------------------------------
@@ -459,21 +812,22 @@
                DO ji = 1, jpi
                   !
-                  IF( a_i(ji,jj,jl) > epsi10 .AND. athorn(ji,jj,jl) > 0._wp ) THEN
-                     zhi = v_i(ji,jj,jl) / a_i(ji,jj,jl)
+                  IF( athorn(ji,jj,jl) > 0._wp ) THEN
                      !----------------------------
                      ! PE loss from deforming ice
                      !----------------------------
-                     strength(ji,jj) = strength(ji,jj) - athorn(ji,jj,jl) * zhi * zhi
+                     strength(ji,jj) = strength(ji,jj) - athorn(ji,jj,jl) * ht_i(ji,jj,jl) * ht_i(ji,jj,jl)
 
                      !--------------------------
                      ! PE gain from rafting ice
                      !--------------------------
-                     strength(ji,jj) = strength(ji,jj) + 2._wp * araft(ji,jj,jl) * zhi * zhi
+                     strength(ji,jj) = strength(ji,jj) + 2._wp * araft(ji,jj,jl) * ht_i(ji,jj,jl) * ht_i(ji,jj,jl)
 
                      !----------------------------
                      ! PE gain from ridging ice
                      !----------------------------
-                     strength(ji,jj) = strength(ji,jj) + aridge(ji,jj,jl) / krdg(ji,jj,jl)     &
-                        * z1_3 * ( hrmax(ji,jj,jl)**2 + hrmin(ji,jj,jl)**2 +  hrmax(ji,jj,jl) * hrmin(ji,jj,jl) )  
+                     strength(ji,jj) = strength(ji,jj) + aridge(ji,jj,jl) * krdg(ji,jj,jl) * z1_3 *  &
+                        &                              ( hrmax(ji,jj,jl) * hrmax(ji,jj,jl) +         &
+                        &                                hrmin(ji,jj,jl) * hrmin(ji,jj,jl) +         &
+                        &                                hrmax(ji,jj,jl) * hrmin(ji,jj,jl) )  
                         !!(a**3-b**3)/(a-b) = a*a+ab+b*b                      
                   ENDIF
@@ -497,5 +851,4 @@
          !
       ENDIF                     ! kstrngth
-
       !
       !------------------------------------------------------------------------------!
@@ -503,7 +856,5 @@
       !------------------------------------------------------------------------------!
       ! CAN BE REMOVED
-      !
       IF( ln_icestr_bvf ) THEN
-
          DO jj = 1, jpj
             DO ji = 1, jpi
@@ -511,7 +862,5 @@
             END DO
          END DO
-
       ENDIF
-
       !
       !------------------------------------------------------------------------------!
@@ -558,5 +907,4 @@
       IF ( ksmooth == 2 ) THEN
 
-
          CALL lbc_lnk( strength, 'T', 1. )
 
@@ -565,6 +913,6 @@
                IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp) THEN 
                   numts_rm = 1 ! number of time steps for the running mean
-                  IF ( strp1(ji,jj) > 0.0 ) numts_rm = numts_rm + 1
-                  IF ( strp2(ji,jj) > 0.0 ) numts_rm = numts_rm + 1
+                  IF ( strp1(ji,jj) > 0._wp ) numts_rm = numts_rm + 1
+                  IF ( strp2(ji,jj) > 0._wp ) numts_rm = numts_rm + 1
                   zp = ( strength(ji,jj) + strp1(ji,jj) + strp2(ji,jj) ) / numts_rm
                   strp2(ji,jj) = strp1(ji,jj)
@@ -583,616 +931,4 @@
       !
    END SUBROUTINE lim_itd_me_icestrength
-
-
-   SUBROUTINE lim_itd_me_ridgeprep
-      !!---------------------------------------------------------------------!
-      !!                ***  ROUTINE lim_itd_me_ridgeprep ***
-      !!
-      !! ** Purpose :   preparation for ridging and strength calculations
-      !!
-      !! ** Method  :   Compute the thickness distribution of the ice and open water 
-      !!              participating in ridging and of the resulting ridges.
-      !!---------------------------------------------------------------------!
-      INTEGER ::   ji,jj, jl    ! dummy loop indices
-      REAL(wp) ::   Gstari, astari, zhi, hrmean, zdummy   ! local scalar
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   zworka    ! temporary array used here
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   Gsum      ! Gsum(n) = sum of areas in categories 0 to n
-      !------------------------------------------------------------------------------!
-
-      CALL wrk_alloc( jpi,jpj, zworka )
-      CALL wrk_alloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 )
-
-      Gstari     = 1.0/rn_gstar    
-      astari     = 1.0/rn_astar    
-      aksum(:,:)    = 0.0
-      athorn(:,:,:) = 0.0
-      aridge(:,:,:) = 0.0
-      araft (:,:,:) = 0.0
-      hrmin(:,:,:)  = 0.0 
-      hrmax(:,:,:)  = 0.0 
-      hraft(:,:,:)  = 0.0 
-      krdg (:,:,:)  = 1.0
-
-      !     ! Zero out categories with very small areas
-      CALL lim_var_zapsmall
-
-      !------------------------------------------------------------------------------!
-      ! 1) Participation function 
-      !------------------------------------------------------------------------------!
-
-      ! Compute total area of ice plus open water.
-      ! This is in general not equal to one because of divergence during transport
-      asum(:,:) = ato_i(:,:)
-      DO jl = 1, jpl
-         asum(:,:) = asum(:,:) + a_i(:,:,jl)
-      END DO
-
-      ! Compute cumulative thickness distribution function
-      ! Compute the cumulative thickness distribution function Gsum,
-      ! where Gsum(n) is the fractional area in categories 0 to n.
-      ! initial value (in h = 0) equals open water area
-
-      Gsum(:,:,-1) = 0._wp
-      Gsum(:,:,0 ) = ato_i(:,:)
-
-      ! for each value of h, you have to add ice concentration then
-      DO jl = 1, jpl
-         Gsum(:,:,jl) = Gsum(:,:,jl-1) + a_i(:,:,jl)
-      END DO
-
-      ! Normalize the cumulative distribution to 1
-      zworka(:,:) = 1._wp / Gsum(:,:,jpl)
-      DO jl = 0, jpl
-         Gsum(:,:,jl) = Gsum(:,:,jl) * zworka(:,:)
-      END DO
-
-      ! 1.3 Compute participation function a(h) = b(h).g(h) (athorn)
-      !--------------------------------------------------------------------------------------------------
-      ! Compute the participation function athorn; this is analogous to
-      ! a(h) = b(h)g(h) as defined in Thorndike et al. (1975).
-      ! area lost from category n due to ridging/closing
-      ! athorn(n)   = total area lost due to ridging/closing
-      ! assume b(h) = (2/Gstar) * (1 - G(h)/Gstar). 
-      !
-      ! The expressions for athorn are found by integrating b(h)g(h) between
-      ! the category boundaries.
-      !-----------------------------------------------------------------
-
-      IF( nn_partfun == 0 ) THEN       !--- Linear formulation (Thorndike et al., 1975)
-         DO jl = 0, jpl    
-            DO jj = 1, jpj 
-               DO ji = 1, jpi
-                  IF( Gsum(ji,jj,jl) < rn_gstar) THEN
-                     athorn(ji,jj,jl) = Gstari * ( Gsum(ji,jj,jl) - Gsum(ji,jj,jl-1) ) * &
-                        &                        ( 2.0 - (Gsum(ji,jj,jl-1) + Gsum(ji,jj,jl) ) * Gstari )
-                  ELSEIF (Gsum(ji,jj,jl-1) < rn_gstar) THEN
-                     athorn(ji,jj,jl) = Gstari * ( rn_gstar - Gsum(ji,jj,jl-1) ) *  &
-                        &                        ( 2.0 - ( Gsum(ji,jj,jl-1) + rn_gstar ) * Gstari )
-                  ELSE
-                     athorn(ji,jj,jl) = 0.0
-                  ENDIF
-               END DO
-            END DO
-         END DO
-
-      ELSE                             !--- Exponential, more stable formulation (Lipscomb et al, 2007)
-         !                        
-         zdummy = 1._wp / ( 1._wp - EXP(-astari) )        ! precompute exponential terms using Gsum as a work array
-         DO jl = -1, jpl
-            Gsum(:,:,jl) = EXP( -Gsum(:,:,jl) * astari ) * zdummy
-         END DO
-         DO jl = 0, jpl
-             athorn(:,:,jl) = Gsum(:,:,jl-1) - Gsum(:,:,jl)
-         END DO
-         !
-      ENDIF
-
-      IF( ln_rafting ) THEN      ! Ridging and rafting ice participation functions
-         !
-         DO jl = 1, jpl
-            DO jj = 1, jpj 
-               DO ji = 1, jpi
-                  IF ( athorn(ji,jj,jl) > 0._wp ) THEN
-!!gm  TANH( -X ) = - TANH( X )  so can be computed only 1 time....
-                     aridge(ji,jj,jl) = ( TANH (  rn_craft * ( ht_i(ji,jj,jl) - rn_hraft ) ) + 1.0 ) * 0.5 * athorn(ji,jj,jl)
-                     araft (ji,jj,jl) = ( TANH ( -rn_craft * ( ht_i(ji,jj,jl) - rn_hraft ) ) + 1.0 ) * 0.5 * athorn(ji,jj,jl)
-                     IF ( araft(ji,jj,jl) < epsi06 )   araft(ji,jj,jl)  = 0._wp
-                     aridge(ji,jj,jl) = MAX( athorn(ji,jj,jl) - araft(ji,jj,jl), 0.0 )
-                  ENDIF
-               END DO
-            END DO
-         END DO
-
-      ELSE
-         !
-         DO jl = 1, jpl
-            aridge(:,:,jl) = athorn(:,:,jl)
-         END DO
-         !
-      ENDIF
-
-      IF( ln_rafting ) THEN
-
-         IF( MAXVAL(aridge + araft - athorn(:,:,1:jpl)) > epsi10 .AND. lwp ) THEN
-            DO jl = 1, jpl
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     IF ( aridge(ji,jj,jl) + araft(ji,jj,jl) - athorn(ji,jj,jl) > epsi10 ) THEN
-                        WRITE(numout,*) ' ALERTE 96 : wrong participation function ... '
-                        WRITE(numout,*) ' ji, jj, jl : ', ji, jj, jl
-                        WRITE(numout,*) ' lat, lon   : ', gphit(ji,jj), glamt(ji,jj)
-                        WRITE(numout,*) ' aridge     : ', aridge(ji,jj,1:jpl)
-                        WRITE(numout,*) ' araft      : ', araft(ji,jj,1:jpl)
-                        WRITE(numout,*) ' athorn     : ', athorn(ji,jj,1:jpl)
-                     ENDIF
-                  END DO
-               END DO
-            END DO
-         ENDIF
-
-      ENDIF
-
-      !-----------------------------------------------------------------
-      ! 2) Transfer function
-      !-----------------------------------------------------------------
-      ! Compute max and min ridged ice thickness for each ridging category.
-      ! Assume ridged ice is uniformly distributed between hrmin and hrmax.
-      ! 
-      ! This parameterization is a modified version of Hibler (1980).
-      ! The mean ridging thickness, hrmean, is proportional to hi^(0.5)
-      !  and for very thick ridging ice must be >= krdgmin*hi
-      !
-      ! The minimum ridging thickness, hrmin, is equal to 2*hi 
-      !  (i.e., rafting) and for very thick ridging ice is
-      !  constrained by hrmin <= (hrmean + hi)/2.
-      ! 
-      ! The maximum ridging thickness, hrmax, is determined by
-      !  hrmean and hrmin.
-      !
-      ! These modifications have the effect of reducing the ice strength
-      ! (relative to the Hibler formulation) when very thick ice is
-      ! ridging.
-      !
-      ! aksum = net area removed/ total area removed
-      ! where total area removed = area of ice that ridges
-      !         net area removed = total area removed - area of new ridges
-      !-----------------------------------------------------------------
-
-      ! Transfer function
-      DO jl = 1, jpl !all categories have a specific transfer function
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-
-               IF (a_i(ji,jj,jl) > epsi10 .AND. athorn(ji,jj,jl) > 0.0 ) THEN
-                  zhi = v_i(ji,jj,jl) / a_i(ji,jj,jl)
-                  hrmean          = MAX(SQRT(rn_hstar*zhi), zhi*krdgmin)
-                  hrmin(ji,jj,jl) = MIN(2.0*zhi, 0.5*(hrmean + zhi))
-                  hrmax(ji,jj,jl) = 2.0*hrmean - hrmin(ji,jj,jl)
-                  hraft(ji,jj,jl) = kraft*zhi
-                  krdg(ji,jj,jl)  = hrmean / zhi
-               ELSE
-                  hraft(ji,jj,jl) = 0.0
-                  hrmin(ji,jj,jl) = 0.0 
-                  hrmax(ji,jj,jl) = 0.0 
-                  krdg (ji,jj,jl) = 1.0
-               ENDIF
-
-            END DO
-         END DO
-      END DO
-
-      ! Normalization factor : aksum, ensures mass conservation
-      aksum(:,:) = athorn(:,:,0)
-      DO jl = 1, jpl 
-         aksum(:,:)    = aksum(:,:) + aridge(:,:,jl) * ( 1._wp - 1._wp / krdg(:,:,jl) )    &
-            &                       + araft (:,:,jl) * ( 1._wp - 1._wp / kraft        )
-      END DO
-      !
-      CALL wrk_dealloc( jpi,jpj, zworka )
-      CALL wrk_dealloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 )
-      !
-   END SUBROUTINE lim_itd_me_ridgeprep
-
-
-   SUBROUTINE lim_itd_me_ridgeshift( opning, closing_gross, msnow_mlt, esnow_mlt )
-      !!----------------------------------------------------------------------
-      !!                ***  ROUTINE lim_itd_me_icestrength ***
-      !!
-      !! ** Purpose :   shift ridging ice among thickness categories of ice thickness
-      !!
-      !! ** Method  :   Remove area, volume, and energy from each ridging category
-      !!              and add to thicker ice categories.
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   opning         ! rate of opening due to divergence/shear
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   closing_gross  ! rate at which area removed, excluding area of new ridges
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   msnow_mlt      ! mass of snow added to ocean (kg m-2)
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   esnow_mlt      ! energy needed to melt snow in ocean (J m-2)
-      !
-      CHARACTER (len=80) ::   fieldid   ! field identifier
-      LOGICAL, PARAMETER ::   l_conservation_check = .true.  ! if true, check conservation (useful for debugging)
-      !
-      INTEGER ::   ji, jj, jl, jl1, jl2, jk   ! dummy loop indices
-      INTEGER ::   ij                ! horizontal index, combines i and j loops
-      INTEGER ::   icells            ! number of cells with aicen > puny
-      REAL(wp) ::   hL, hR, farea, ztmelts    ! left and right limits of integration
-
-      INTEGER , POINTER, DIMENSION(:) ::   indxi, indxj   ! compressed indices
-
-      REAL(wp), POINTER, DIMENSION(:,:) ::   vice_init, vice_final   ! ice volume summed over categories
-      REAL(wp), POINTER, DIMENSION(:,:) ::   eice_init, eice_final   ! ice energy summed over layers
-
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   aicen_init, vicen_init   ! ice  area    & volume before ridging
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   vsnwn_init, esnwn_init   ! snow volume  & energy before ridging
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   smv_i_init, oa_i_init    ! ice salinity & age    before ridging
-
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   eicen_init        ! ice energy before ridging
-
-      REAL(wp), POINTER, DIMENSION(:,:) ::   afrac , fvol     ! fraction of category area ridged & new ridge volume going to n2
-      REAL(wp), POINTER, DIMENSION(:,:) ::   ardg1 , ardg2    ! area of ice ridged & new ridges
-      REAL(wp), POINTER, DIMENSION(:,:) ::   vsrdg , esrdg    ! snow volume & energy of ridging ice
-      REAL(wp), POINTER, DIMENSION(:,:) ::   dhr   , dhr2     ! hrmax - hrmin  &  hrmax^2 - hrmin^2
-
-      REAL(wp), POINTER, DIMENSION(:,:) ::   vrdg1   ! volume of ice ridged
-      REAL(wp), POINTER, DIMENSION(:,:) ::   vrdg2   ! volume of new ridges
-      REAL(wp), POINTER, DIMENSION(:,:) ::   vsw     ! volume of seawater trapped into ridges
-      REAL(wp), POINTER, DIMENSION(:,:) ::   srdg1   ! sal*volume of ice ridged
-      REAL(wp), POINTER, DIMENSION(:,:) ::   srdg2   ! sal*volume of new ridges
-      REAL(wp), POINTER, DIMENSION(:,:) ::   smsw    ! sal*volume of water trapped into ridges
-      REAL(wp), POINTER, DIMENSION(:,:) ::   oirdg1, oirdg2   ! ice age of ice ridged
-
-      REAL(wp), POINTER, DIMENSION(:,:) ::   afrft            ! fraction of category area rafted
-      REAL(wp), POINTER, DIMENSION(:,:) ::   arft1 , arft2    ! area of ice rafted and new rafted zone
-      REAL(wp), POINTER, DIMENSION(:,:) ::   virft , vsrft    ! ice & snow volume of rafting ice
-      REAL(wp), POINTER, DIMENSION(:,:) ::   esrft , smrft    ! snow energy & salinity of rafting ice
-      REAL(wp), POINTER, DIMENSION(:,:) ::   oirft1, oirft2   ! ice age of ice rafted
-
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   eirft      ! ice energy of rafting ice
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   erdg1      ! enth*volume of ice ridged
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   erdg2      ! enth*volume of new ridges
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ersw       ! enth of water trapped into ridges
-      !!----------------------------------------------------------------------
-
-      CALL wrk_alloc( (jpi+1)*(jpj+1),       indxi, indxj )
-      CALL wrk_alloc( jpi, jpj,              vice_init, vice_final, eice_init, eice_final )
-      CALL wrk_alloc( jpi, jpj,              afrac, fvol , ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 )
-      CALL wrk_alloc( jpi, jpj,              vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw, oirdg1, oirdg2 )
-      CALL wrk_alloc( jpi, jpj,              afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 )
-      CALL wrk_alloc( jpi, jpj, jpl,         aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init )
-      CALL wrk_alloc( jpi, jpj, nlay_i,      eirft, erdg1, erdg2, ersw )
-      CALL wrk_alloc( jpi, jpj, nlay_i, jpl, eicen_init )
-
-      ! Conservation check
-      eice_init(:,:) = 0._wp
-
-      IF( con_i ) THEN
-         CALL lim_column_sum        (jpl,    v_i,       vice_init )
-         CALL lim_column_sum_energy (jpl, nlay_i,  e_i, eice_init )
-         DO ji = mi0(iiceprt), mi1(iiceprt)
-            DO jj = mj0(jiceprt), mj1(jiceprt)
-               WRITE(numout,*) ' vice_init  : ', vice_init(ji,jj)
-               WRITE(numout,*) ' eice_init  : ', eice_init(ji,jj)
-            END DO
-         END DO
-      ENDIF
-
-      !-------------------------------------------------------------------------------
-      ! 1) Compute change in open water area due to closing and opening.
-      !-------------------------------------------------------------------------------
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            ato_i(ji,jj) = ato_i(ji,jj) - athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice        &
-               &                        + opning(ji,jj)                          * rdt_ice
-            IF    ( ato_i(ji,jj) < -epsi10 ) THEN    ! there is a bug
-               IF(lwp)   WRITE(numout,*) 'Ridging error: ato_i < 0 -- ato_i : ',ato_i(ji,jj)
-            ELSEIF( ato_i(ji,jj) < 0._wp   ) THEN    ! roundoff error
-               ato_i(ji,jj) = 0._wp
-            ENDIF
-         END DO
-      END DO
-
-      !-----------------------------------------------------------------
-      ! 2) Save initial state variables
-      !-----------------------------------------------------------------
-      aicen_init(:,:,:)   = a_i  (:,:,:)
-      vicen_init(:,:,:)   = v_i  (:,:,:)
-      vsnwn_init(:,:,:)   = v_s  (:,:,:)
-      smv_i_init(:,:,:)   = smv_i(:,:,:)
-      esnwn_init(:,:,:)   = e_s  (:,:,1,:)
-      eicen_init(:,:,:,:) = e_i  (:,:,:,:)
-      oa_i_init (:,:,:)   = oa_i (:,:,:)
-
-      !
-      !-----------------------------------------------------------------
-      ! 3) Pump everything from ice which is being ridged / rafted
-      !-----------------------------------------------------------------
-      ! Compute the area, volume, and energy of ice ridging in each
-      ! category, along with the area of the resulting ridge.
-
-      DO jl1 = 1, jpl !jl1 describes the ridging category
-
-         !------------------------------------------------
-         ! 3.1) Identify grid cells with nonzero ridging
-         !------------------------------------------------
-
-         icells = 0
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( aicen_init(ji,jj,jl1) > epsi10 .AND. athorn(ji,jj,jl1) > 0._wp  &
-                  &   .AND. closing_gross(ji,jj) > 0._wp ) THEN
-                  icells = icells + 1
-                  indxi(icells) = ji
-                  indxj(icells) = jj
-               ENDIF
-            END DO
-         END DO
-
-         DO ij = 1, icells
-            ji = indxi(ij)
-            jj = indxj(ij)
-
-            !--------------------------------------------------------------------
-            ! 3.2) Compute area of ridging ice (ardg1) and of new ridge (ardg2)
-            !--------------------------------------------------------------------
-
-            ardg1(ji,jj) = aridge(ji,jj,jl1)*closing_gross(ji,jj)*rdt_ice
-            arft1(ji,jj) = araft (ji,jj,jl1)*closing_gross(ji,jj)*rdt_ice
-            ardg2(ji,jj) = ardg1(ji,jj) / krdg(ji,jj,jl1)
-            arft2(ji,jj) = arft1(ji,jj) / kraft
-
-            !---------------------------------------------------------------
-            ! 3.3) Compute ridging /rafting fractions, make sure afrac <=1 
-            !---------------------------------------------------------------
-
-            afrac(ji,jj) = ardg1(ji,jj) / aicen_init(ji,jj,jl1) !ridging
-            afrft(ji,jj) = arft1(ji,jj) / aicen_init(ji,jj,jl1) !rafting
-
-            IF( afrac(ji,jj) > kamax + epsi10 ) THEN  ! there is a bug
-               IF(lwp)   WRITE(numout,*) ' ardg > a_i -- ardg, aicen_init : ', ardg1(ji,jj), aicen_init(ji,jj,jl1)
-            ELSEIF( afrac(ji,jj) > kamax ) THEN       ! roundoff error
-               afrac(ji,jj) = kamax
-            ENDIF
-
-            IF( afrft(ji,jj) > kamax + epsi10 ) THEN ! there is a bug
-               IF(lwp)   WRITE(numout,*) ' arft > a_i -- arft, aicen_init : ', arft1(ji,jj), aicen_init(ji,jj,jl1) 
-            ELSEIF( afrft(ji,jj) > kamax) THEN       ! roundoff error
-               afrft(ji,jj) = kamax
-            ENDIF
-
-            !--------------------------------------------------------------------------
-            ! 3.4) Subtract area, volume, and energy from ridging 
-            !     / rafting category n1.
-            !--------------------------------------------------------------------------
-            vrdg1(ji,jj) = vicen_init(ji,jj,jl1) * afrac(ji,jj)
-            vrdg2(ji,jj) = vrdg1(ji,jj) * ( 1. + rn_por_rdg )
-            vsw  (ji,jj) = vrdg1(ji,jj) * rn_por_rdg
-
-            vsrdg (ji,jj) = vsnwn_init(ji,jj,jl1) * afrac(ji,jj)
-            esrdg (ji,jj) = esnwn_init(ji,jj,jl1) * afrac(ji,jj)
-            srdg1 (ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj)
-            oirdg1(ji,jj) = oa_i_init (ji,jj,jl1) * afrac(ji,jj)
-            oirdg2(ji,jj) = oa_i_init (ji,jj,jl1) * afrac(ji,jj) / krdg(ji,jj,jl1) 
-
-            ! rafting volumes, heat contents ...
-            virft (ji,jj) = vicen_init(ji,jj,jl1) * afrft(ji,jj)
-            vsrft (ji,jj) = vsnwn_init(ji,jj,jl1) * afrft(ji,jj)
-            esrft (ji,jj) = esnwn_init(ji,jj,jl1) * afrft(ji,jj)
-            smrft (ji,jj) = smv_i_init(ji,jj,jl1) * afrft(ji,jj) 
-            oirft1(ji,jj) = oa_i_init (ji,jj,jl1) * afrft(ji,jj) 
-            oirft2(ji,jj) = oa_i_init (ji,jj,jl1) * afrft(ji,jj) / kraft 
-
-            ! substract everything
-            a_i(ji,jj,jl1)   = a_i(ji,jj,jl1)   - ardg1 (ji,jj) - arft1 (ji,jj)
-            v_i(ji,jj,jl1)   = v_i(ji,jj,jl1)   - vrdg1 (ji,jj) - virft (ji,jj)
-            v_s(ji,jj,jl1)   = v_s(ji,jj,jl1)   - vsrdg (ji,jj) - vsrft (ji,jj)
-            e_s(ji,jj,1,jl1) = e_s(ji,jj,1,jl1) - esrdg (ji,jj) - esrft (ji,jj)
-            smv_i(ji,jj,jl1) = smv_i(ji,jj,jl1) - srdg1 (ji,jj) - smrft (ji,jj)
-            oa_i(ji,jj,jl1)  = oa_i(ji,jj,jl1)  - oirdg1(ji,jj) - oirft1(ji,jj)
-
-            !-----------------------------------------------------------------
-            ! 3.5) Compute properties of new ridges
-            !-----------------------------------------------------------------
-            !---------
-            ! Salinity
-            !---------
-            smsw(ji,jj)  = vsw(ji,jj) * sss_m(ji,jj)                      ! salt content of seawater frozen in voids !! MV HC2014
-            srdg2(ji,jj) = srdg1(ji,jj) + smsw(ji,jj)                     ! salt content of new ridge
-
-            !srdg2(ji,jj) = MIN( rn_simax * vrdg2(ji,jj) , zsrdg2 )         ! impose a maximum salinity
-            
-            sfx_dyn(ji,jj) = sfx_dyn(ji,jj) - smsw(ji,jj) * rhoic * r1_rdtice
-            wfx_dyn(ji,jj) = wfx_dyn(ji,jj) - vsw (ji,jj) * rhoic * r1_rdtice   ! increase in ice volume du to seawater frozen in voids             
-
-            !------------------------------------            
-            ! 3.6 Increment ridging diagnostics
-            !------------------------------------            
-
-            !        jl1 looping 1-jpl
-            !           ij looping 1-icells
-
-            dardg1dt   (ji,jj) = dardg1dt(ji,jj) + ardg1(ji,jj) + arft1(ji,jj)
-            dardg2dt   (ji,jj) = dardg2dt(ji,jj) + ardg2(ji,jj) + arft2(ji,jj)
-            opening    (ji,jj) = opening (ji,jj) + opning(ji,jj) * rdt_ice
-
-            IF( con_i )   vice_init(ji,jj) = vice_init(ji,jj) + vrdg2(ji,jj) - vrdg1(ji,jj)
-
-            !------------------------------------------            
-            ! 3.7 Put the snow somewhere in the ocean
-            !------------------------------------------            
-            !  Place part of the snow lost by ridging into the ocean. 
-            !  Note that esnow_mlt < 0; the ocean must cool to melt snow.
-            !  If the ocean temp = Tf already, new ice must grow.
-            !  During the next time step, thermo_rates will determine whether
-            !  the ocean cools or new ice grows.
-            !        jl1 looping 1-jpl
-            !           ij looping 1-icells
-
-            msnow_mlt(ji,jj) = msnow_mlt(ji,jj) + rhosn*vsrdg(ji,jj)*(1.0-rn_fsnowrdg)   &   ! rafting included
-               &                                + rhosn*vsrft(ji,jj)*(1.0-rn_fsnowrft)
-
-            ! in J/m2 (same as e_s)
-            esnow_mlt(ji,jj) = esnow_mlt(ji,jj) - esrdg(ji,jj)*(1.0-rn_fsnowrdg)         &   !rafting included
-               &                                - esrft(ji,jj)*(1.0-rn_fsnowrft)          
-
-            !-----------------------------------------------------------------
-            ! 3.8 Compute quantities used to apportion ice among categories
-            ! in the n2 loop below
-            !-----------------------------------------------------------------
-
-            !        jl1 looping 1-jpl
-            !           ij looping 1-icells
-
-            dhr (ji,jj) = hrmax(ji,jj,jl1) - hrmin(ji,jj,jl1)
-            dhr2(ji,jj) = hrmax(ji,jj,jl1) * hrmax(ji,jj,jl1) - hrmin(ji,jj,jl1) * hrmin(ji,jj,jl1)
-
-         END DO
-
-         !--------------------------------------------------------------------
-         ! 3.9 Compute ridging ice enthalpy, remove it from ridging ice and
-         !      compute ridged ice enthalpy 
-         !--------------------------------------------------------------------
-         DO jk = 1, nlay_i
-            DO ij = 1, icells
-               ji = indxi(ij)
-               jj = indxj(ij)
-               ! heat content of ridged ice
-               erdg1(ji,jj,jk)      = eicen_init(ji,jj,jk,jl1) * afrac(ji,jj) 
-               eirft(ji,jj,jk)      = eicen_init(ji,jj,jk,jl1) * afrft(ji,jj)
-               e_i  (ji,jj,jk,jl1)  = e_i(ji,jj,jk,jl1) - erdg1(ji,jj,jk) - eirft(ji,jj,jk)
-               
-               
-               ! enthalpy of the trapped seawater (J/m2, >0)
-               ! clem: if sst>0, then ersw <0 (is that possible?)
-               ersw(ji,jj,jk)   = - rhoic * vsw(ji,jj) * rcp * sst_m(ji,jj) * r1_nlay_i
-
-               ! heat flux to the ocean
-               hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + ersw(ji,jj,jk) * r1_rdtice  ! > 0 [W.m-2] ocean->ice flux 
-
-               ! it is added to sea ice because the sign convention is the opposite of the sign convention for the ocean
-               erdg2(ji,jj,jk)  = erdg1(ji,jj,jk) + ersw(ji,jj,jk)
-
-            END DO
-         END DO
-
-
-         IF( con_i ) THEN
-            DO jk = 1, nlay_i
-               DO ij = 1, icells
-                  ji = indxi(ij)
-                  jj = indxj(ij)
-                  eice_init(ji,jj) = eice_init(ji,jj) + erdg2(ji,jj,jk) - erdg1(ji,jj,jk)
-               END DO
-            END DO
-         ENDIF
-
-         !-------------------------------------------------------------------------------
-         ! 4) Add area, volume, and energy of new ridge to each category jl2
-         !-------------------------------------------------------------------------------
-         !        jl1 looping 1-jpl
-         DO jl2  = 1, jpl 
-            ! over categories to which ridged ice is transferred
-            DO ij = 1, icells
-               ji = indxi(ij)
-               jj = indxj(ij)
-
-               ! Compute the fraction of ridged ice area and volume going to 
-               ! thickness category jl2.
-               ! Transfer area, volume, and energy accordingly.
-
-               IF( hrmin(ji,jj,jl1) >= hi_max(jl2) .OR. hrmax(ji,jj,jl1) <= hi_max(jl2-1) ) THEN
-                  hL = 0._wp
-                  hR = 0._wp
-               ELSE
-                  hL = MAX( hrmin(ji,jj,jl1), hi_max(jl2-1) )
-                  hR = MIN( hrmax(ji,jj,jl1), hi_max(jl2)   )
-               ENDIF
-
-               ! fraction of ridged ice area and volume going to n2
-               farea = ( hR - hL ) / dhr(ji,jj) 
-               fvol(ji,jj) = ( hR*hR - hL*hL ) / dhr2(ji,jj)
-
-               a_i  (ji,jj  ,jl2) = a_i  (ji,jj  ,jl2) + ardg2 (ji,jj) * farea
-               v_i  (ji,jj  ,jl2) = v_i  (ji,jj  ,jl2) + vrdg2 (ji,jj) * fvol(ji,jj)
-               v_s  (ji,jj  ,jl2) = v_s  (ji,jj  ,jl2) + vsrdg (ji,jj) * fvol(ji,jj) * rn_fsnowrdg
-               e_s  (ji,jj,1,jl2) = e_s  (ji,jj,1,jl2) + esrdg (ji,jj) * fvol(ji,jj) * rn_fsnowrdg
-               smv_i(ji,jj  ,jl2) = smv_i(ji,jj  ,jl2) + srdg2 (ji,jj) * fvol(ji,jj)
-               oa_i (ji,jj  ,jl2) = oa_i (ji,jj  ,jl2) + oirdg2(ji,jj) * farea
-
-            END DO
-
-            ! Transfer ice energy to category jl2 by ridging
-            DO jk = 1, nlay_i
-               DO ij = 1, icells
-                  ji = indxi(ij)
-                  jj = indxj(ij)
-                  e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) + fvol(ji,jj) * erdg2(ji,jj,jk)
-               END DO
-            END DO
-            !
-         END DO                 ! jl2 (new ridges)            
-
-         DO jl2 = 1, jpl 
-
-            DO ij = 1, icells
-               ji = indxi(ij)
-               jj = indxj(ij)
-               ! Compute the fraction of rafted ice area and volume going to 
-               ! thickness category jl2, transfer area, volume, and energy accordingly.
-               !
-               IF( hraft(ji,jj,jl1) <= hi_max(jl2) .AND. hraft(ji,jj,jl1) >  hi_max(jl2-1) ) THEN
-                  a_i  (ji,jj  ,jl2) = a_i  (ji,jj  ,jl2) + arft2 (ji,jj)
-                  v_i  (ji,jj  ,jl2) = v_i  (ji,jj  ,jl2) + virft (ji,jj)
-                  v_s  (ji,jj  ,jl2) = v_s  (ji,jj  ,jl2) + vsrft (ji,jj) * rn_fsnowrft
-                  e_s  (ji,jj,1,jl2) = e_s  (ji,jj,1,jl2) + esrft (ji,jj) * rn_fsnowrft
-                  smv_i(ji,jj  ,jl2) = smv_i(ji,jj  ,jl2) + smrft (ji,jj)    
-                  oa_i (ji,jj  ,jl2) = oa_i (ji,jj  ,jl2) + oirft2(ji,jj)
-               ENDIF
-               !
-            END DO
-
-            ! Transfer rafted ice energy to category jl2 
-            DO jk = 1, nlay_i
-               DO ij = 1, icells
-                  ji = indxi(ij)
-                  jj = indxj(ij)
-                  IF( hraft(ji,jj,jl1) <= hi_max(jl2) .AND. hraft(ji,jj,jl1) > hi_max(jl2-1)  ) THEN
-                     e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) + eirft(ji,jj,jk)
-                  ENDIF
-               END DO
-            END DO
-
-         END DO
-
-      END DO ! jl1 (deforming categories)
-
-      ! Conservation check
-      IF ( con_i ) THEN
-         CALL lim_column_sum (jpl,   v_i, vice_final)
-         fieldid = ' v_i : limitd_me '
-         CALL lim_cons_check (vice_init, vice_final, 1.0e-6, fieldid) 
-
-         CALL lim_column_sum_energy (jpl, nlay_i,  e_i, eice_final )
-         fieldid = ' e_i : limitd_me '
-         CALL lim_cons_check (eice_init, eice_final, 1.0e-2, fieldid) 
-
-         DO ji = mi0(iiceprt), mi1(iiceprt)
-            DO jj = mj0(jiceprt), mj1(jiceprt)
-               WRITE(numout,*) ' vice_init  : ', vice_init (ji,jj)
-               WRITE(numout,*) ' vice_final : ', vice_final(ji,jj)
-               WRITE(numout,*) ' eice_init  : ', eice_init (ji,jj)
-               WRITE(numout,*) ' eice_final : ', eice_final(ji,jj)
-            END DO
-         END DO
-      ENDIF
-      !
-      CALL wrk_dealloc( (jpi+1)*(jpj+1),        indxi, indxj )
-      CALL wrk_dealloc( jpi, jpj,               vice_init, vice_final, eice_init, eice_final )
-      CALL wrk_dealloc( jpi, jpj,               afrac, fvol , ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 )
-      CALL wrk_dealloc( jpi, jpj,               vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw, oirdg1, oirdg2 )
-      CALL wrk_dealloc( jpi, jpj,               afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 )
-      CALL wrk_dealloc( jpi, jpj, jpl,          aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init )
-      CALL wrk_dealloc( jpi, jpj, nlay_i,       eirft, erdg1, erdg2, ersw )
-      CALL wrk_dealloc( jpi, jpj, nlay_i, jpl,  eicen_init )
-      !
-   END SUBROUTINE lim_itd_me_ridgeshift
 
    SUBROUTINE lim_itd_me_init
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90	(revision 6440)
@@ -159,5 +159,5 @@
       CALL wrk_alloc( jpi,jpj, u_oce2, u_ice2, v_oce1 , v_ice1 , zmask               )
       CALL wrk_alloc( jpi,jpj, zf1   , zu_ice, zf2   , zv_ice , zdt    , zds  )
-      CALL wrk_alloc( jpi,jpj, zdt   , zds   , zs1   , zs2   , zs12   , zresr , zpice                 )
+      CALL wrk_alloc( jpi,jpj, zs1   , zs2   , zs12   , zresr , zpice                 )
 
 #if  defined key_lim2 && ! defined key_lim2_vp
@@ -690,5 +690,5 @@
       CALL wrk_dealloc( jpi,jpj, u_oce2, u_ice2, v_oce1 , v_ice1 , zmask               )
       CALL wrk_dealloc( jpi,jpj, zf1   , zu_ice, zf2   , zv_ice , zdt    , zds  )
-      CALL wrk_dealloc( jpi,jpj, zdt   , zds   , zs1   , zs2   , zs12   , zresr , zpice                 )
+      CALL wrk_dealloc( jpi,jpj, zs1   , zs2   , zs12   , zresr , zpice                 )
 
    END SUBROUTINE lim_rhg
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90	(revision 6440)
@@ -94,5 +94,5 @@
       !!              - fr_i    : ice fraction
       !!              - tn_ice  : sea-ice surface temperature
-      !!              - alb_ice : sea-ice albedo (only useful in coupled mode)
+      !!              - alb_ice : sea-ice albedo (recomputed only for coupled mode)
       !!
       !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90.
@@ -106,8 +106,10 @@
       REAL(wp) ::   zqsr                                           ! New solar flux received by the ocean
       !
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb_cs, zalb_os     ! 2D/3D workspace
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb_cs, zalb_os     ! 3D workspace
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zalb                 ! 2D workspace
       !!---------------------------------------------------------------------
 
       ! make calls for heat fluxes before it is modified
+      ! pfrld is the lead fraction at the previous time step (actually between TRP and THD)
       IF( iom_use('qsr_oce') )   CALL iom_put( "qsr_oce" , qsr_oce(:,:) * pfrld(:,:) )                                   !     solar flux at ocean surface
       IF( iom_use('qns_oce') )   CALL iom_put( "qns_oce" , qns_oce(:,:) * pfrld(:,:) + qemp_oce(:,:) )                   ! non-solar flux at ocean surface
@@ -118,8 +120,24 @@
       IF( iom_use('qt_ice' ) )   CALL iom_put( "qt_ice"  , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) )   &
          &                                                      * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) )
-      IF( iom_use('qemp_oce' ) )   CALL iom_put( "qemp_oce"  , qemp_oce(:,:) )  
-      IF( iom_use('qemp_ice' ) )   CALL iom_put( "qemp_ice"  , qemp_ice(:,:) )  
-
-      ! pfrld is the lead fraction at the previous time step (actually between TRP and THD)
+      IF( iom_use('qemp_oce') )  CALL iom_put( "qemp_oce" , qemp_oce(:,:) )  
+      IF( iom_use('qemp_ice') )  CALL iom_put( "qemp_ice" , qemp_ice(:,:) )  
+      IF( iom_use('emp_oce' ) )  CALL iom_put( "emp_oce"  , emp_oce(:,:) )   ! emp over ocean (taking into account the snow blown away from the ice)
+      IF( iom_use('emp_ice' ) )  CALL iom_put( "emp_ice"  , emp_ice(:,:) )   ! emp over ice   (taking into account the snow blown away from the ice)
+
+      ! albedo output
+      CALL wrk_alloc( jpi,jpj, zalb )    
+
+      zalb(:,:) = 0._wp
+      WHERE     ( SUM( a_i_b, dim=3 ) <= epsi06 )  ;  zalb(:,:) = 0.066_wp
+      ELSEWHERE                                    ;  zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) / SUM( a_i_b, dim=3 )
+      END WHERE
+      IF( iom_use('alb_ice' ) )  CALL iom_put( "alb_ice"  , zalb(:,:) )           ! ice albedo output
+
+      zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + 0.066_wp * ( 1._wp - SUM( a_i_b, dim=3 ) )      
+      IF( iom_use('albedo'  ) )  CALL iom_put( "albedo"  , zalb(:,:) )           ! ice albedo output
+
+      CALL wrk_dealloc( jpi,jpj, zalb )    
+      !
+      
       DO jj = 1, jpj
          DO ji = 1, jpi
@@ -140,10 +158,11 @@
             hfx_out(ji,jj) = hfx_out(ji,jj) + zqmass + zqsr
 
-            ! Add the residual from heat diffusion equation (W.m-2)
-            !-------------------------------------------------------
-            hfx_out(ji,jj) = hfx_out(ji,jj) + hfx_err_dif(ji,jj)
+            ! Add the residual from heat diffusion equation and sublimation (W.m-2)
+            !----------------------------------------------------------------------
+            hfx_out(ji,jj) = hfx_out(ji,jj) + hfx_err_dif(ji,jj) +   &
+               &           ( hfx_sub(ji,jj) - SUM( qevap_ice(ji,jj,:) * a_i_b(ji,jj,:) ) )
 
             ! New qsr and qns used to compute the oceanic heat flux at the next time step
-            !---------------------------------------------------
+            !----------------------------------------------------------------------------
             qsr(ji,jj) = zqsr                                      
             qns(ji,jj) = hfx_out(ji,jj) - zqsr              
@@ -165,7 +184,6 @@
 
             ! mass flux at the ocean/ice interface
-            fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) ) * r1_rdtice  ! F/M mass flux save at least for biogeochemical model
-            emp(ji,jj)    = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj)   ! mass flux + F/M mass flux (always ice/ocean mass exchange)
-            
+            fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) + wfx_err_sub(ji,jj) )              ! F/M mass flux save at least for biogeochemical model
+            emp(ji,jj)    = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj)   ! mass flux + F/M mass flux (always ice/ocean mass exchange)
          END DO
       END DO
@@ -175,5 +193,5 @@
       !------------------------------------------!
       sfx(:,:) = sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:)   &
-         &     + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:)
+         &     + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) + sfx_sub(:,:)
 
       !-------------------------------------------------------------!
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90	(revision 6440)
@@ -461,5 +461,5 @@
 
       DO ji = kideb, kiut
-         zdh_mel = MIN( 0._wp, dh_i_surf(ji) + dh_i_bott(ji) + dh_snowice(ji) )
+         zdh_mel = MIN( 0._wp, dh_i_surf(ji) + dh_i_bott(ji) + dh_snowice(ji) + dh_i_sub(ji) )
          IF( zdh_mel < 0._wp .AND. a_i_1d(ji) > 0._wp )  THEN
             zvi          = a_i_1d(ji) * ht_i_1d(ji)
@@ -470,5 +470,5 @@
             zda_mel     = rswitch * a_i_1d(ji) * zdh_mel / ( 2._wp * MAX( zhi_bef, epsi20 ) )
             a_i_1d(ji)  = MAX( epsi20, a_i_1d(ji) + zda_mel ) 
-             ! adjust thickness
+            ! adjust thickness
             ht_i_1d(ji) = zvi / a_i_1d(ji)            
             ht_s_1d(ji) = zvs / a_i_1d(ji)            
@@ -514,4 +514,5 @@
          
          CALL tab_2d_1d( nbpb, qprec_ice_1d(1:nbpb), qprec_ice(:,:) , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, qevap_ice_1d(1:nbpb), qevap_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
          CALL tab_2d_1d( nbpb, qsr_ice_1d (1:nbpb), qsr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
          CALL tab_2d_1d( nbpb, fr1_i0_1d  (1:nbpb), fr1_i0          , jpi, jpj, npb(1:nbpb) )
@@ -543,5 +544,6 @@
          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, sfx_sub_1d (1:nbpb), sfx_sub         , 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) )
@@ -593,5 +595,6 @@
          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, sfx_sub       , npb, sfx_sub_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 )
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90	(revision 6440)
@@ -74,5 +74,5 @@
 
       REAL(wp) ::   ztmelts             ! local scalar
-      REAL(wp) ::   zfdum       
+      REAL(wp) ::   zdum       
       REAL(wp) ::   zfracs       ! fractionation coefficient for bottom salt entrapment
       REAL(wp) ::   zs_snic      ! snow-ice salinity
@@ -95,4 +95,5 @@
       REAL(wp), POINTER, DIMENSION(:) ::   zq_rema     ! remaining heat at the end of the routine    (J.m-2)
       REAL(wp), POINTER, DIMENSION(:) ::   zf_tt       ! Heat budget to determine melting or freezing(W.m-2)
+      REAL(wp), POINTER, DIMENSION(:) ::   zevap_rema  ! remaining mass flux from sublimation        (kg.m-2)
 
       REAL(wp), POINTER, DIMENSION(:) ::   zdh_s_mel   ! snow melt 
@@ -105,6 +106,4 @@
 
       REAL(wp), POINTER, DIMENSION(:) ::   zqh_i       ! total ice heat content  (J.m-2)
-      REAL(wp), POINTER, DIMENSION(:) ::   zqh_s       ! total snow heat content (J.m-2)
-      REAL(wp), POINTER, DIMENSION(:) ::   zq_s        ! total snow enthalpy     (J.m-3)
       REAL(wp), POINTER, DIMENSION(:) ::   zsnw        ! distribution of snow after wind blowing
 
@@ -122,16 +121,15 @@
       END SELECT
 
-      CALL wrk_alloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw )
-      CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s )
+      CALL wrk_alloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw, zevap_rema )
+      CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i )
       CALL wrk_alloc( jpij, nlay_i, zdeltah, zh_i )
       CALL wrk_alloc( jpij, nlay_i, icount )
        
-      dh_i_surf  (:) = 0._wp ; dh_i_bott  (:) = 0._wp ; dh_snowice(:) = 0._wp
+      dh_i_surf  (:) = 0._wp ; dh_i_bott  (:) = 0._wp ; dh_snowice(:) = 0._wp ; dh_i_sub(:) = 0._wp
       dsm_i_se_1d(:) = 0._wp ; dsm_i_si_1d(:) = 0._wp   
 
       zqprec   (:) = 0._wp ; zq_su    (:) = 0._wp ; zq_bo    (:) = 0._wp ; zf_tt(:) = 0._wp
-      zq_rema  (:) = 0._wp ; zsnw     (:) = 0._wp
+      zq_rema  (:) = 0._wp ; zsnw     (:) = 0._wp ; zevap_rema(:) = 0._wp ;
       zdh_s_mel(:) = 0._wp ; zdh_s_pre(:) = 0._wp ; zdh_s_sub(:) = 0._wp ; zqh_i(:) = 0._wp
-      zqh_s    (:) = 0._wp ; zq_s     (:) = 0._wp     
 
       zdeltah(:,:) = 0._wp ; zh_i(:,:) = 0._wp       
@@ -159,8 +157,8 @@
       !
       DO ji = kideb, kiut
-         zfdum      = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji) 
+         zdum       = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji) 
          zf_tt(ji)  = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji) 
 
-         zq_su (ji) = MAX( 0._wp, zfdum     * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - rt0 ) )
+         zq_su (ji) = MAX( 0._wp, zdum      * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - rt0 ) )
          zq_bo (ji) = MAX( 0._wp, zf_tt(ji) * rdt_ice )
       END DO
@@ -187,10 +185,4 @@
       !  2) Computing layer thicknesses and enthalpies.            !
       !------------------------------------------------------------!
-      !
-      DO jk = 1, nlay_s
-         DO ji = kideb, kiut
-            zqh_s(ji) =  zqh_s(ji) + q_s_1d(ji,jk) * ht_s_1d(ji) * r1_nlay_s
-         END DO
-      END DO
       !
       DO jk = 1, nlay_i
@@ -275,17 +267,15 @@
       END DO
 
-      !----------------------
-      ! 3.2 Snow sublimation 
-      !----------------------
+      !------------------------------
+      ! 3.2 Sublimation (part1: snow) 
+      !------------------------------
       ! qla_ice is always >=0 (upwards), heat goes to the atmosphere, therefore snow sublimates
       ! clem comment: not counted in mass/heat exchange in limsbc since this is an exchange with atm. (not ocean)
-      ! clem comment: ice should also sublimate
       zdeltah(:,:) = 0._wp
-      ! coupled mode: sublimation is set to 0 (evap_ice = 0) until further notice
-      ! forced  mode: snow thickness change due to sublimation
-      DO ji = kideb, kiut
-         zdh_s_sub(ji)  =  MAX( - ht_s_1d(ji) , - evap_ice_1d(ji) * r1_rhosn * rdt_ice )
-         ! Heat flux by sublimation [W.m-2], < 0
-         !      sublimate first snow that had fallen, then pre-existing snow
+      DO ji = kideb, kiut
+         zdh_s_sub(ji)  = MAX( - ht_s_1d(ji) , - evap_ice_1d(ji) * r1_rhosn * rdt_ice )
+         ! remaining evap in kg.m-2 (used for ice melting later on)
+         zevap_rema(ji)  = evap_ice_1d(ji) * rdt_ice + zdh_s_sub(ji) * rhosn
+         ! Heat flux by sublimation [W.m-2], < 0 (sublimate first snow that had fallen, then pre-existing snow)
          zdeltah(ji,1)  = MAX( zdh_s_sub(ji), - zdh_s_pre(ji) )
          hfx_sub_1d(ji) = hfx_sub_1d(ji) + ( zdeltah(ji,1) * zqprec(ji) + ( zdh_s_sub(ji) - zdeltah(ji,1) ) * q_s_1d(ji,1)  &
@@ -309,12 +299,10 @@
       !-------------------------------------------
       ! new temp and enthalpy of the snow (remaining snow precip + remaining pre-existing snow)
-      zq_s(:) = 0._wp 
       DO jk = 1, nlay_s
          DO ji = kideb,kiut
-            rswitch       = MAX(  0._wp , SIGN( 1._wp, ht_s_1d(ji) - epsi20 )  )
-            q_s_1d(ji,jk) = rswitch / MAX( ht_s_1d(ji), epsi20 ) *                          &
-              &            ( (   zdh_s_pre(ji)             ) * zqprec(ji) +  &
-              &              (   ht_s_1d(ji) - zdh_s_pre(ji) ) * rhosn * ( cpic * ( rt0 - t_s_1d(ji,jk) ) + lfus ) )
-            zq_s(ji)     =  zq_s(ji) + q_s_1d(ji,jk)
+            rswitch       = MAX( 0._wp , SIGN( 1._wp, ht_s_1d(ji) - epsi20 ) )
+            q_s_1d(ji,jk) = rswitch / MAX( ht_s_1d(ji), epsi20 ) *           &
+              &            ( ( zdh_s_pre(ji)               ) * zqprec(ji) +  &
+              &              ( ht_s_1d(ji) - zdh_s_pre(ji) ) * rhosn * ( cpic * ( rt0 - t_s_1d(ji,jk) ) + lfus ) )
          END DO
       END DO
@@ -370,5 +358,5 @@
                zQm            = zfmdt * zEw                           ! Energy of the melt water sent to the ocean [J/m2, <0]
                
-               ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok)
+               ! Contribution to salt flux >0 (clem: using sm_i_1d and not s_i_1d(jk) is ok)
                sfx_sum_1d(ji) = sfx_sum_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice
                
@@ -383,4 +371,20 @@
                
             END IF
+            ! ----------------------
+            ! Sublimation part2: ice
+            ! ----------------------
+            zdum      = MAX( - ( zh_i(ji,jk) + zdeltah(ji,jk) ) , - zevap_rema(ji) * r1_rhoic )
+            zdeltah(ji,jk) = zdeltah(ji,jk) + zdum
+            dh_i_sub(ji)  = dh_i_sub(ji) + zdum
+            ! Salt flux > 0 (clem2016: flux is sent to the ocean for simplicity but salt should remain in the ice except if all ice is melted.
+            !                          It must be corrected at some point)
+            sfx_sub_1d(ji) = sfx_sub_1d(ji) - rhoic * a_i_1d(ji) * zdum * sm_i_1d(ji) * r1_rdtice
+            ! Heat flux [W.m-2], < 0
+            hfx_sub_1d(ji) = hfx_sub_1d(ji) + zdum * q_i_1d(ji,jk) * a_i_1d(ji) * r1_rdtice
+            ! Mass flux > 0
+            wfx_sub_1d(ji) =  wfx_sub_1d(ji) - rhoic * a_i_1d(ji) * zdum * r1_rdtice
+            ! update remaining mass flux
+            zevap_rema(ji)  = zevap_rema(ji) + zdum * rhoic
+            
             ! record which layers have disappeared (for bottom melting) 
             !    => icount=0 : no layer has vanished
@@ -389,5 +393,5 @@
             icount(ji,jk) = NINT( rswitch )
             zh_i(ji,jk)   = MAX( 0._wp , zh_i(ji,jk) + zdeltah(ji,jk) )
-
+                        
             ! update heat content (J.m-2) and layer thickness
             qh_i_old(ji,jk) = qh_i_old(ji,jk) + zdeltah(ji,jk) * q_i_1d(ji,jk)
@@ -397,5 +401,11 @@
       ! update ice thickness
       DO ji = kideb, kiut
-         ht_i_1d(ji) =  MAX( 0._wp , ht_i_1d(ji) + dh_i_surf(ji) )
+         ht_i_1d(ji) =  MAX( 0._wp , ht_i_1d(ji) + dh_i_surf(ji) + dh_i_sub(ji) )
+      END DO
+
+      ! remaining "potential" evap is sent to ocean
+      DO ji = kideb, kiut
+         ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1
+         wfx_err_sub(ii,ij) = wfx_err_sub(ii,ij) - zevap_rema(ji) * a_i_1d(ji) * r1_rdtice  ! <=0 (net evap for the ocean in kg.m-2.s-1)
       END DO
 
@@ -686,6 +696,6 @@
       WHERE( ht_i_1d == 0._wp ) a_i_1d = 0._wp
       
-      CALL wrk_dealloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw )
-      CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s )
+      CALL wrk_dealloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw, zevap_rema )
+      CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i )
       CALL wrk_dealloc( jpij, nlay_i, zdeltah, zh_i )
       CALL wrk_dealloc( jpij, nlay_i, icount )
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90	(revision 6440)
@@ -75,7 +75,6 @@
       INTEGER ::   ii, ij, iter     !   -       -
       REAL(wp)  ::   ztmelts, zdv, zfrazb, zweight, zde                         ! local scalars
-      REAL(wp) ::   zgamafr, zvfrx, zvgx, ztaux, ztwogp, zf , zhicol_new        !   -      -
+      REAL(wp) ::   zgamafr, zvfrx, zvgx, ztaux, ztwogp, zf                     !   -      -
       REAL(wp) ::   ztenagm, zvfry, zvgy, ztauy, zvrel2, zfp, zsqcd , zhicrit   !   -      -
-      LOGICAL  ::   iterate_frazil   ! iterate frazil ice collection thickness
       CHARACTER (len = 15) :: fieldid
 
@@ -108,9 +107,9 @@
       REAL(wp), POINTER, DIMENSION(:,:) ::   zsmv_i_1d ! 1-D version of smv_i
 
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze_i_1d   !: 1-D version of e_i
-
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zvrel                   ! relative ice / frazil velocity
-
-      REAL(wp) :: zcai = 1.4e-3_wp
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze_i_1d !: 1-D version of e_i
+
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zvrel     ! relative ice / frazil velocity
+
+      REAL(wp) :: zcai = 1.4e-3_wp                     ! ice-air drag (clem: should be dependent on coupling/forcing used)
       !!-----------------------------------------------------------------------!
 
@@ -143,6 +142,5 @@
       !------------------------------------------------------------------------------!    
       ! hicol is the thickness of new ice formed in open water
-      ! hicol can be either prescribed (frazswi = 0)
-      ! or computed (frazswi = 1)
+      ! hicol can be either prescribed (frazswi = 0) or computed (frazswi = 1)
       ! Frazil ice forms in open water, is transported by wind
       ! accumulates at the edge of the consolidated ice edge
@@ -155,6 +153,8 @@
       zvrel(:,:) = 0._wp
 
-      ! Default new ice thickness 
-      hicol(:,:) = rn_hnewice
+      ! Default new ice thickness
+      WHERE( qlead(:,:) < 0._wp ) ; hicol = rn_hnewice
+      ELSEWHERE                   ; hicol = 0._wp
+      END WHERE
 
       IF( ln_frazil ) THEN
@@ -182,5 +182,5 @@
                      &          +   vtau_ice(ji  ,jj  ) * vmask(ji  ,jj  ,1) ) * 0.5_wp
                   ! Square root of wind stress
-                  ztenagm       =  SQRT( SQRT( ztaux**2 + ztauy**2 ) )
+                  ztenagm       =  SQRT( SQRT( ztaux * ztaux + ztauy * ztauy ) )
 
                   !---------------------
@@ -205,41 +205,29 @@
                   zvrel2 = MAX(  ( zvfrx - zvgx ) * ( zvfrx - zvgx )   &
                      &         + ( zvfry - zvgy ) * ( zvfry - zvgy ) , 0.15 * 0.15 )
-                  zvrel(ji,jj)  = SQRT( zvrel2 )
+                  zvrel(ji,jj) = SQRT( zvrel2 )
 
                   !---------------------
                   ! Iterative procedure
                   !---------------------
-                  hicol(ji,jj) = zhicrit + 0.1 
-                  hicol(ji,jj) = zhicrit +   hicol(ji,jj)    &
-                     &                   / ( hicol(ji,jj) * hicol(ji,jj) -  zhicrit * zhicrit ) * ztwogp * zvrel2
-
-!!gm better coding: above: hicol(ji,jj) * hicol(ji,jj) = (zhicrit + 0.1)*(zhicrit + 0.1)
-!!gm                                                   = zhicrit**2 + 0.2*zhicrit +0.01
-!!gm                therefore the 2 lines with hicol can be replaced by 1 line:
-!!gm              hicol(ji,jj) = zhicrit + (zhicrit + 0.1) / ( 0.2 * zhicrit + 0.01 ) * ztwogp * zvrel2
-!!gm further more (zhicrit + 0.1)/(0.2 * zhicrit + 0.01 )*ztwogp can be computed one for all outside the DO loop
+                  hicol(ji,jj) = zhicrit +   ( zhicrit + 0.1 )    &
+                     &                   / ( ( zhicrit + 0.1 ) * ( zhicrit + 0.1 ) -  zhicrit * zhicrit ) * ztwogp * zvrel2
 
                   iter = 1
-                  iterate_frazil = .true.
-
-                  DO WHILE ( iter < 100 .AND. iterate_frazil ) 
-                     zf = ( hicol(ji,jj) - zhicrit ) * ( hicol(ji,jj)**2 - zhicrit**2 ) &
-                        - hicol(ji,jj) * zhicrit * ztwogp * zvrel2
-                     zfp = ( hicol(ji,jj) - zhicrit ) * ( 3.0*hicol(ji,jj) + zhicrit ) &
-                        - zhicrit * ztwogp * zvrel2
-                     zhicol_new = hicol(ji,jj) - zf/zfp
-                     hicol(ji,jj)   = zhicol_new
-
+                  DO WHILE ( iter < 20 ) 
+                     zf  = ( hicol(ji,jj) - zhicrit ) * ( hicol(ji,jj) * hicol(ji,jj) - zhicrit * zhicrit ) -   &
+                        &    hicol(ji,jj) * zhicrit * ztwogp * zvrel2
+                     zfp = ( hicol(ji,jj) - zhicrit ) * ( 3.0 * hicol(ji,jj) + zhicrit ) - zhicrit * ztwogp * zvrel2
+
+                     hicol(ji,jj) = hicol(ji,jj) - zf/zfp
                      iter = iter + 1
-
-                  END DO ! do while
+                  END DO
 
                ENDIF ! end of selection of pixels where ice forms
 
-            END DO ! loop on ji ends
-         END DO ! loop on jj ends
-      ! 
-      CALL lbc_lnk( zvrel(:,:), 'T', 1. )
-      CALL lbc_lnk( hicol(:,:), 'T', 1. )
+            END DO 
+         END DO 
+         ! 
+         CALL lbc_lnk( zvrel(:,:), 'T', 1. )
+         CALL lbc_lnk( hicol(:,:), 'T', 1. )
 
       ENDIF ! End of computation of frazil ice collection thickness
@@ -282,6 +270,5 @@
       ! Move from 2-D to 1-D vectors
       !------------------------------
-      ! If ocean gains heat do nothing 
-      ! 0therwise compute new ice formation
+      ! If ocean gains heat do nothing. Otherwise compute new ice formation
 
       IF ( nbpac > 0 ) THEN
@@ -297,13 +284,14 @@
          END DO
 
-         CALL tab_2d_1d( nbpac, qlead_1d  (1:nbpac)     , qlead  , jpi, jpj, npac(1:nbpac) )
-         CALL tab_2d_1d( nbpac, t_bo_1d   (1:nbpac)     , t_bo   , jpi, jpj, npac(1:nbpac) )
-         CALL tab_2d_1d( nbpac, sfx_opw_1d(1:nbpac)     , sfx_opw, jpi, jpj, npac(1:nbpac) )
-         CALL tab_2d_1d( nbpac, wfx_opw_1d(1:nbpac)     , wfx_opw, jpi, jpj, npac(1:nbpac) )
-         CALL tab_2d_1d( nbpac, hicol_1d  (1:nbpac)     , hicol  , jpi, jpj, npac(1:nbpac) )
-         CALL tab_2d_1d( nbpac, zvrel_1d  (1:nbpac)     , zvrel  , jpi, jpj, npac(1:nbpac) )
-
-         CALL tab_2d_1d( nbpac, hfx_thd_1d(1:nbpac)     , hfx_thd, jpi, jpj, npac(1:nbpac) )
-         CALL tab_2d_1d( nbpac, hfx_opw_1d(1:nbpac)     , hfx_opw, jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d( nbpac, qlead_1d  (1:nbpac)     , qlead     , jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d( nbpac, t_bo_1d   (1:nbpac)     , t_bo      , jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d( nbpac, sfx_opw_1d(1:nbpac)     , sfx_opw   , jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d( nbpac, wfx_opw_1d(1:nbpac)     , wfx_opw   , jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d( nbpac, hicol_1d  (1:nbpac)     , hicol     , jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d( nbpac, zvrel_1d  (1:nbpac)     , zvrel     , jpi, jpj, npac(1:nbpac) )
+
+         CALL tab_2d_1d( nbpac, hfx_thd_1d(1:nbpac)     , hfx_thd   , jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d( nbpac, hfx_opw_1d(1:nbpac)     , hfx_opw   , jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d( nbpac, rn_amax_1d(1:nbpac)     , rn_amax_2d, jpi, jpj, npac(1:nbpac) )
 
          !------------------------------------------------------------------------------!
@@ -316,11 +304,9 @@
          zv_b(1:nbpac,:) = zv_i_1d(1:nbpac,:) 
          za_b(1:nbpac,:) = za_i_1d(1:nbpac,:)
+
          !----------------------
          ! Thickness of new ice
          !----------------------
-         DO ji = 1, nbpac
-            zh_newice(ji) = rn_hnewice
-         END DO
-         IF( ln_frazil ) zh_newice(1:nbpac) = hicol_1d(1:nbpac)
+         zh_newice(1:nbpac) = hicol_1d(1:nbpac)
 
          !----------------------
@@ -384,12 +370,17 @@
             ! salt flux
             sfx_opw_1d(ji) = sfx_opw_1d(ji) - zv_newice(ji) * rhoic * zs_newice(ji) * r1_rdtice
-
+         END DO
+         
+         zv_frazb(:) = 0._wp
+         IF( ln_frazil ) THEN
             ! A fraction zfrazb of frazil ice is accreted at the ice bottom
-            rswitch       = 1._wp - MAX( 0._wp, SIGN( 1._wp , - zat_i_1d(ji) ) )
-            zfrazb        = rswitch * ( TANH ( rn_Cfrazb * ( zvrel_1d(ji) - rn_vfrazb ) ) + 1.0 ) * 0.5 * rn_maxfrazb
-            zv_frazb(ji)  =         zfrazb   * zv_newice(ji)
-            zv_newice(ji) = ( 1.0 - zfrazb ) * zv_newice(ji)
-         END DO
-
+            DO ji = 1, nbpac
+               rswitch       = 1._wp - MAX( 0._wp, SIGN( 1._wp , - zat_i_1d(ji) ) )
+               zfrazb        = rswitch * ( TANH( rn_Cfrazb * ( zvrel_1d(ji) - rn_vfrazb ) ) + 1.0 ) * 0.5 * rn_maxfrazb
+               zv_frazb(ji)  =         zfrazb   * zv_newice(ji)
+               zv_newice(ji) = ( 1.0 - zfrazb ) * zv_newice(ji)
+            END DO
+         END IF
+         
          !-----------------
          ! Area of new ice
@@ -409,6 +400,6 @@
          ! we keep the excessive volume in memory and attribute it later to bottom accretion
          DO ji = 1, nbpac
-            IF ( za_newice(ji) >  ( rn_amax - zat_i_1d(ji) ) ) THEN
-               zda_res(ji)   = za_newice(ji) - ( rn_amax - zat_i_1d(ji) )
+            IF ( za_newice(ji) >  ( rn_amax_1d(ji) - zat_i_1d(ji) ) ) THEN
+               zda_res(ji)   = za_newice(ji) - ( rn_amax_1d(ji) - zat_i_1d(ji) )
                zdv_res(ji)   = zda_res  (ji) * zh_newice(ji) 
                za_newice(ji) = za_newice(ji) - zda_res  (ji)
@@ -443,5 +434,5 @@
                jl = jcat(ji)
                rswitch = MAX( 0._wp, SIGN( 1._wp , zv_i_1d(ji,jl) - epsi20 ) )
-               ze_i_1d(ji,jk,jl) = zswinew(ji)   *   ze_newice(ji) +                                                      &
+               ze_i_1d(ji,jk,jl) = zswinew(ji)   *   ze_newice(ji) +                                                    &
                   &        ( 1.0 - zswinew(ji) ) * ( ze_newice(ji) * zv_newice(ji) + ze_i_1d(ji,jk,jl) * zv_b(ji,jl) )  &
                   &        * rswitch / MAX( zv_i_1d(ji,jl), epsi20 )
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90	(revision 6440)
@@ -422,5 +422,5 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  a_i(ji,jj,1)  = MIN( a_i(ji,jj,1), rn_amax )
+                  a_i(ji,jj,1)  = MIN( a_i(ji,jj,1), rn_amax_2d(ji,jj) )
                END DO
             END DO
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90	(revision 6440)
@@ -80,7 +80,7 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               IF( at_i(ji,jj) > rn_amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN
-                  a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) )
-                  oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) )
+               IF( at_i(ji,jj) > rn_amax_2d(ji,jj) .AND. a_i(ji,jj,jl) > 0._wp ) THEN
+                  a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax_2d(ji,jj) / at_i(ji,jj) ) )
+                  oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax_2d(ji,jj) / at_i(ji,jj) ) )
                ENDIF
             END DO
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90	(revision 6440)
@@ -94,7 +94,7 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               IF( at_i(ji,jj) > rn_amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN
-                  a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) )
-                  oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) )
+               IF( at_i(ji,jj) > rn_amax_2d(ji,jj) .AND. a_i(ji,jj,jl) > 0._wp ) THEN
+                  a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax_2d(ji,jj) / at_i(ji,jj) ) )
+                  oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax_2d(ji,jj) / at_i(ji,jj) ) )
                ENDIF
             END DO
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90	(revision 6440)
@@ -163,4 +163,20 @@
                rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) )   !0 if no ice and 1 if yes
                ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
+            END DO
+         END DO
+      END DO
+      ! Force the upper limit of ht_i to always be < hi_max (99 m).
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            rswitch = MAX( 0._wp , SIGN( 1._wp, ht_i(ji,jj,jpl) - epsi20 ) )
+            ht_i(ji,jj,jpl) = MIN( ht_i(ji,jj,jpl) , hi_max(jpl) )
+            a_i (ji,jj,jpl) = v_i(ji,jj,jpl) / MAX( ht_i(ji,jj,jpl) , epsi20 ) * rswitch
+         END DO
+      END DO
+
+      DO jl = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) )   !0 if no ice and 1 if yes
                ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
                o_i(ji,jj,jl)  = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
@@ -168,5 +184,5 @@
          END DO
       END DO
-
+      
       IF(  nn_icesal == 2  )THEN
          DO jl = 1, jpl
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90	(revision 6440)
@@ -157,13 +157,5 @@
       ENDIF
 
-      IF ( iom_use( "icecolf" ) ) THEN 
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               rswitch  = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) ) )
-               z2d(ji,jj) = hicol(ji,jj) * rswitch
-            END DO
-         END DO
-         CALL iom_put( "icecolf"     , z2d              )        ! frazil ice collection thickness
-      ENDIF
+      IF ( iom_use( "icecolf" ) )   CALL iom_put( "icecolf", hicol )  ! frazil ice collection thickness
 
       CALL iom_put( "isst"        , sst_m               )        ! sea surface temperature
@@ -190,12 +182,13 @@
       CALL iom_put( "destrp"      , diag_trp_es         )        ! advected snw enthalpy (W/m2)
 
-      CALL iom_put( "sfxbog"      , sfx_bog * rday      )        ! salt flux from brines
-      CALL iom_put( "sfxbom"      , sfx_bom * rday      )        ! salt flux from brines
-      CALL iom_put( "sfxsum"      , sfx_sum * rday      )        ! salt flux from brines
-      CALL iom_put( "sfxsni"      , sfx_sni * rday      )        ! salt flux from brines
-      CALL iom_put( "sfxopw"      , sfx_opw * rday      )        ! salt flux from brines
+      CALL iom_put( "sfxbog"      , sfx_bog * rday      )        ! salt flux from bottom growth
+      CALL iom_put( "sfxbom"      , sfx_bom * rday      )        ! salt flux from bottom melt
+      CALL iom_put( "sfxsum"      , sfx_sum * rday      )        ! salt flux from surface melt
+      CALL iom_put( "sfxsni"      , sfx_sni * rday      )        ! salt flux from snow ice formation
+      CALL iom_put( "sfxopw"      , sfx_opw * rday      )        ! salt flux from open water formation
       CALL iom_put( "sfxdyn"      , sfx_dyn * rday      )        ! salt flux from ridging rafting
-      CALL iom_put( "sfxres"      , sfx_res * rday      )        ! salt flux from limupdate (resultant)
+      CALL iom_put( "sfxres"      , sfx_res * rday      )        ! salt flux from residual
       CALL iom_put( "sfxbri"      , sfx_bri * rday      )        ! salt flux from brines
+      CALL iom_put( "sfxsub"      , sfx_sub * rday      )        ! salt flux from sublimation
       CALL iom_put( "sfx"         , sfx     * rday      )        ! total salt flux
 
@@ -235,4 +228,17 @@
       CALL iom_put ('hfxdhc'     , diag_heat(:,:)       )   ! Heat content variation in snow and ice 
       CALL iom_put ('hfxspr'     , hfx_spr(:,:)         )   ! Heat content of snow precip 
+
+
+      IF ( iom_use( "vfxthin" ) ) THEN   ! ice production for open water + thin ice (<20cm) => comparable to observations  
+         DO jj = 1, jpj 
+            DO ji = 1, jpi
+               z2d(ji,jj)  = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zswi(ji,jj) ! mean ice thickness
+            END DO
+         END DO
+         WHERE( z2d(:,:) < 0.2 .AND. z2d(:,:) > 0. ) ; z2da = wfx_bog
+         ELSEWHERE                                   ; z2da = 0._wp
+         END WHERE
+         CALL iom_put( "vfxthin", ( wfx_opw + z2da ) * ztmp )
+      ENDIF
       
       !--------------------------------
@@ -311,5 +317,5 @@
       !!
       !! History :
-      !!   4.1  !  2013-06  (C. Rousset)
+      !!   4.0  !  2013-06  (C. Rousset)
       !!----------------------------------------------------------------------
       INTEGER, INTENT( in ) ::   kt               ! ocean time-step index)
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90	(revision 6440)
@@ -45,4 +45,5 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qns_ice_1d  
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_bo_1d     
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   rn_amax_1d
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_sum_1d
@@ -83,4 +84,6 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_res_1d  
 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_sub_1d
+
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sprecip_1d    !: <==> the 2D  sprecip
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   frld_1d       !: <==> the 2D  frld
@@ -91,4 +94,5 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   evap_ice_1d   !: <==> the 2D  evap_ice
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qprec_ice_1d  !: <==> the 2D  qprec_ice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qevap_ice_1d  !: <==> the 3D  qevap_ice
    !                                                     ! to reintegrate longwave flux inside the ice thermodynamics
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   i0            !: fraction of radiation transmitted to the ice
@@ -107,4 +111,5 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_s_tot      !: Snow accretion/ablation        [m]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_surf     !: Ice surface accretion/ablation [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_sub      !: Ice surface sublimation [m]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_bott     !: Ice bottom accretion/ablation  [m]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_snowice    !: Snow ice formation             [m of ice]
@@ -144,4 +149,5 @@
          &      hfx_sum_1d(jpij) , hfx_bom_1d(jpij) ,hfx_bog_1d(jpij) ,    & 
          &      hfx_dif_1d(jpij) , hfx_opw_1d(jpij) ,                      &
+         &      rn_amax_1d(jpij) ,                                         &
          &      hfx_thd_1d(jpij) , hfx_spr_1d(jpij) ,                      &
          &      hfx_snw_1d(jpij) , hfx_sub_1d(jpij) , hfx_err_1d(jpij) ,   &
@@ -153,7 +159,7 @@
          &      wfx_sum_1d(jpij)  , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) , wfx_res_1d(jpij) ,  &
          &      dqns_ice_1d(jpij) , evap_ice_1d (jpij),                                         &
-         &      qprec_ice_1d(jpij), i0         (jpij) ,                                         &  
+         &      qprec_ice_1d(jpij), qevap_ice_1d(jpij), i0         (jpij) ,                     &  
          &      sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) , sfx_sum_1d (jpij),  &
-         &      sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) ,                     &
+         &      sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) , sfx_sub_1d (jpij),  &
          &      dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) ,                     &     
          &      dsm_i_si_1d(jpij) , hicol_1d    (jpij)                     , STAT=ierr(2) )
@@ -161,6 +167,6 @@
       ALLOCATE( t_su_1d   (jpij) , a_i_1d   (jpij) , ht_i_1d  (jpij) ,    &   
          &      ht_s_1d   (jpij) , fc_su    (jpij) , fc_bo_i  (jpij) ,    &    
-         &      dh_s_tot  (jpij) , dh_i_surf(jpij) , dh_i_bott(jpij) ,    &    
-         &      dh_snowice(jpij) , sm_i_1d  (jpij) , s_i_new  (jpij) ,    &
+         &      dh_s_tot  (jpij) , dh_i_surf(jpij) , dh_i_sub (jpij) ,    &    
+         &      dh_i_bott (jpij) ,dh_snowice(jpij) , sm_i_1d  (jpij) , s_i_new  (jpij) ,    &
          &      t_s_1d(jpij,nlay_s) , t_i_1d(jpij,nlay_i) , s_i_1d(jpij,nlay_i) ,  &            
          &      q_i_1d(jpij,nlay_i+1) , q_s_1d(jpij,nlay_s) ,                        &
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/NST_SRC/agrif2model.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/NST_SRC/agrif2model.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/NST_SRC/agrif2model.F90	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/NST_SRC/agrif_lim2_update.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/NST_SRC/agrif_lim2_update.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/NST_SRC/agrif_lim2_update.F90	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90	(revision 6440)
@@ -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
@@ -29,139 +30,42 @@
    USE wrk_nemo
    USE dynspg_oce
-
+   USE zdf_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
-    
+   INTEGER :: bdy_tinterp = 0
+
    PUBLIC   Agrif_tra, Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts, Agrif_dta_ts
-   PUBLIC   interpu, interpv, interpunb, interpvnb, interpsshn
+   PUBLIC   interpun, interpvn, interpun2d, interpvn2d 
+   PUBLIC   interptsn,  interpsshn
+   PUBLIC   interpunb, interpvnb, interpub2b, interpvb2b
+   PUBLIC   interpe3t, interpumsk, interpvmsk
+# if defined key_zdftke
+   PUBLIC   Agrif_tke, interpavm
+# endif
 
 #  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_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_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)
-            DO jk = 1, jpkm1
-               DO jj = 1, jpj
-                  IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN
-                     tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)
-                  ELSE
-                     tsa(nlci-1,jj,jk,jn)=(alpha4*tsa(nlci,jj,jk,jn)+alpha3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)
-                     IF( un(nlci-2,jj,jk) > 0.e0 ) THEN
-                        tsa(nlci-1,jj,jk,jn)=( alpha6*tsa(nlci-2,jj,jk,jn)+alpha5*tsa(nlci,jj,jk,jn)  &
-                           &                 + alpha7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk)
-                     ENDIF
-                  ENDIF
-               END DO
-            END DO
-         ENDDO
-      ENDIF
-
-      IF( nbondj == 1 .OR. nbondj == 2 ) THEN
-
-         DO jn = 1, jpts
-            tsa(:,nlcj,:,jn) = alpha1 * ztsa(:,nlcj,:,jn) + alpha2 * ztsa(:,nlcj-1,:,jn)
-            DO jk = 1, jpkm1
-               DO ji = 1, jpi
-                  IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN
-                     tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)
-                  ELSE
-                     tsa(ji,nlcj-1,jk,jn)=(alpha4*tsa(ji,nlcj,jk,jn)+alpha3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)        
-                     IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN
-                        tsa(ji,nlcj-1,jk,jn)=( alpha6*tsa(ji,nlcj-2,jk,jn)+alpha5*tsa(ji,nlcj,jk,jn)  &
-                           &                 + alpha7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)
-                     ENDIF
-                  ENDIF
-               END DO
-            END DO
-         ENDDO 
-      ENDIF
-
-      IF( nbondi == -1 .OR. nbondi == 2 ) THEN
-         DO jn = 1, jpts
-            tsa(1,:,:,jn) = alpha1 * ztsa(1,:,:,jn) + alpha2 * ztsa(2,:,:,jn)
-            DO jk = 1, jpkm1
-               DO jj = 1, jpj
-                  IF( umask(2,jj,jk) == 0.e0 ) THEN
-                     tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk)
-                  ELSE
-                     tsa(2,jj,jk,jn)=(alpha4*tsa(1,jj,jk,jn)+alpha3*tsa(3,jj,jk,jn))*tmask(2,jj,jk)        
-                     IF( un(2,jj,jk) < 0.e0 ) THEN
-                        tsa(2,jj,jk,jn)=(alpha6*tsa(3,jj,jk,jn)+alpha5*tsa(1,jj,jk,jn)+alpha7*tsa(4,jj,jk,jn))*tmask(2,jj,jk)
-                     ENDIF
-                  ENDIF
-               END DO
-            END DO
-         END DO
-      ENDIF
-
-      IF( nbondj == -1 .OR. nbondj == 2 ) THEN
-         DO jn = 1, jpts
-            tsa(:,1,:,jn) = alpha1 * ztsa(:,1,:,jn) + alpha2 * ztsa(:,2,:,jn)
-            DO jk=1,jpk      
-               DO ji=1,jpi
-                  IF( vmask(ji,2,jk) == 0.e0 ) THEN
-                     tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk)
-                  ELSE
-                     tsa(ji,2,jk,jn)=(alpha4*tsa(ji,1,jk,jn)+alpha3*tsa(ji,3,jk,jn))*tmask(ji,2,jk)
-                     IF( vn(ji,2,jk) < 0.e0 ) THEN
-                        tsa(ji,2,jk,jn)=(alpha6*tsa(ji,3,jk,jn)+alpha5*tsa(ji,1,jk,jn)+alpha7*tsa(ji,4,jk,jn))*tmask(ji,2,jk)
-                     ENDIF
-                  ENDIF
-               END DO
-            END DO
-         ENDDO
-      ENDIF
-      !
-      CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztsa ) 
       !
    END SUBROUTINE Agrif_tra
@@ -175,16 +79,27 @@
       INTEGER, INTENT(in) ::   kt
       !!
-      INTEGER :: ji,jj,jk
+      INTEGER :: ji,jj,jk, j1,j2, i1,i2
       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
+      REAL(wp), POINTER, DIMENSION(:,:) :: spgv1, spgu1
       !!----------------------------------------------------------------------  
 
       IF( Agrif_Root() )   RETURN
 
-      CALL wrk_alloc( jpi, jpj, spgv1, spgu1, zua2d, zva2d )
-      CALL wrk_alloc( jpi, jpj, jpk, zua, zva )
+      CALL wrk_alloc( jpi, jpj, spgv1, spgu1 )
+
+      Agrif_SpecialValue=0.
+      Agrif_UseSpecialValue = ln_spc_dyn
+
+      CALL Agrif_Bc_variable(un_interp_id,procname=interpun)
+      CALL Agrif_Bc_variable(vn_interp_id,procname=interpvn)
+
+#if defined key_dynspg_flt
+      CALL Agrif_Bc_variable(e1u_id,calledweight=1., procname=interpun2d)
+      CALL Agrif_Bc_variable(e2v_id,calledweight=1., procname=interpvn2d)
+#endif
+
+      Agrif_UseSpecialValue = .FALSE.
 
       zrhox = Agrif_Rhox()
@@ -192,5 +107,4 @@
 
       timeref = 1.
-
       ! time step: leap-frog
       z2dt = 2. * rdt
@@ -200,50 +114,28 @@
       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.
-
+      ! 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
 #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=j1,j2
+               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
-               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)
+               spgu(2,jj)=spgu(2,jj)+fse3u(2,jj,jk)*ua(2,jj,jk)
             END DO
          END DO
@@ -251,5 +143,5 @@
          DO jj=1,jpj
             IF (umask(2,jj,1).NE.0.) THEN
-               spgu(2,jj)=spgu(2,jj)*hur_a(2,jj)
+               spgu(2,jj)=spgu(2,jj)/hu(2,jj)
             ENDIF
          END DO
@@ -259,5 +151,5 @@
 
          DO jk=1,jpkm1
-            DO jj=1,jpj
+            DO jj=j1,j2
                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)
@@ -269,5 +161,5 @@
          DO jk=1,jpkm1
             DO jj=1,jpj
-               spgu1(2,jj)=spgu1(2,jj)+fse3u_a(2,jj,jk)*ua(2,jj,jk)
+               spgu1(2,jj)=spgu1(2,jj)+fse3u(2,jj,jk)*ua(2,jj,jk)
             END DO
          END DO
@@ -275,18 +167,11 @@
          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
+               spgu1(2,jj)=spgu1(2,jj)/hu(2,jj)
+            ENDIF
+         END DO
+
+         DO jk=1,jpkm1
+            DO jj=j1,j2
                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
@@ -300,9 +185,7 @@
             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
@@ -316,35 +199,18 @@
       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=j1,j2
+               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
-               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
-
+               spgu(nlci-2,jj)=spgu(nlci-2,jj)+fse3u(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)
+               spgu(nlci-2,jj)=spgu(nlci-2,jj)/hu(nlci-2,jj)
             ENDIF
          END DO
@@ -352,38 +218,26 @@
          spgu(nlci-2,:) = ua_b(nlci-2,:)
 #endif
-
+         DO jk=1,jpkm1
+            DO jj=j1,j2
+               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
-               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
-
+               spgu1(nlci-2,jj)=spgu1(nlci-2,jj)+fse3u(nlci-2,jj,jk)*ua(nlci-2,jj,jk)*umask(nlci-2,jj,jk)
+            END DO
+         END DO
          DO 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
+               spgu1(nlci-2,jj)=spgu1(nlci-2,jj)/hu(nlci-2,jj)
+            ENDIF
+         END DO
+         DO jk=1,jpkm1
+            DO jj=j1,j2
                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
@@ -414,17 +268,4 @@
 
 #if defined key_dynspg_flt
-         DO ji=1,jpi
-            laplacv(ji,2) = timeref * (zva2d(ji,2)/(zrhox*e1v(ji,2)))
-         END DO
-#endif
-
-         DO jk=1,jpkm1
-            DO ji=1,jpi
-               va(ji,1:2,jk) = (zva(ji,1:2,jk)/(zrhox*e1v(ji,1:2)))
-               va(ji,1:2,jk) = va(ji,1:2,jk) / fse3v_a(ji,1:2,jk)
-            END DO
-         END DO
-
-#if defined key_dynspg_flt
          DO jk=1,jpkm1
             DO ji=1,jpi
@@ -437,5 +278,5 @@
          DO jk=1,jpkm1
             DO ji=1,jpi
-               spgv(ji,2)=spgv(ji,2)+fse3v_a(ji,2,jk)*va(ji,2,jk)
+               spgv(ji,2)=spgv(ji,2)+fse3v(ji,2,jk)*va(ji,2,jk)
             END DO
          END DO
@@ -443,5 +284,5 @@
          DO ji=1,jpi
             IF (vmask(ji,2,1).NE.0.) THEN
-               spgv(ji,2)=spgv(ji,2)*hvr_a(ji,2)
+               spgv(ji,2)=spgv(ji,2)/hv(ji,2)
             ENDIF
          END DO
@@ -451,5 +292,5 @@
 
          DO jk=1,jpkm1
-            DO ji=1,jpi
+            DO ji=i1,i2
                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)
@@ -461,5 +302,5 @@
          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)
+               spgv1(ji,2)=spgv1(ji,2)+fse3v(ji,2,jk)*va(ji,2,jk)*vmask(ji,2,jk)
             END DO
          END DO
@@ -467,5 +308,5 @@
          DO ji=1,jpi
             IF (vmask(ji,2,1).NE.0.) THEN
-               spgv1(ji,2)=spgv1(ji,2)*hvr_a(ji,2)
+               spgv1(ji,2)=spgv1(ji,2)/hv(ji,2)
             ENDIF
          END DO
@@ -474,11 +315,4 @@
             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
@@ -508,17 +342,4 @@
 
 #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
@@ -527,9 +348,10 @@
          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)
+               spgv(ji,nlcj-2)=spgv(ji,nlcj-2)+fse3v(ji,nlcj-2,jk)*va(ji,nlcj-2,jk)
             END DO
          END DO
@@ -537,7 +359,8 @@
          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
+               spgv(ji,nlcj-2)=spgv(ji,nlcj-2)/hv(ji,nlcj-2)
+            ENDIF
+         END DO
+
 #else
          spgv(:,nlcj-2)=va_b(:,nlcj-2)
@@ -545,5 +368,5 @@
 
          DO jk=1,jpkm1
-            DO ji=1,jpi
+            DO ji=i1,i2
                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)
@@ -555,5 +378,5 @@
          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)
+               spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+fse3v(ji,nlcj-2,jk)*va(ji,nlcj-2,jk)
             END DO
          END DO
@@ -561,5 +384,5 @@
          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)
+               spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)/hv(ji,nlcj-2)
             ENDIF
          END DO
@@ -568,11 +391,4 @@
             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
@@ -600,6 +416,5 @@
       ENDIF
       !
-      CALL wrk_dealloc( jpi, jpj, spgv1, spgu1, zua2d, zva2d )
-      CALL wrk_dealloc( jpi, jpj, jpk, zua, zva )
+      CALL wrk_dealloc( jpi, jpj, spgv1, spgu1 )
       !
    END SUBROUTINE Agrif_dyn
@@ -620,9 +435,9 @@
          DO jj=1,jpj
             va_e(2,jj) = vbdy_w(jj) * hvr_e(2,jj)
-! Specified fluxes:
+            ! Specified fluxes:
             ua_e(2,jj) = ubdy_w(jj) * hur_e(2,jj)
-! Characteristics method:
-!alt            ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) &
-!alt                       &           - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) )
+            ! Characteristics method:
+            !alt            ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) &
+            !alt                       &           - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) )
          END DO
       ENDIF
@@ -631,9 +446,9 @@
          DO jj=1,jpj
             va_e(nlci-1,jj) = vbdy_e(jj) * hvr_e(nlci-1,jj)
-! Specified fluxes:
+            ! Specified fluxes:
             ua_e(nlci-2,jj) = ubdy_e(jj) * hur_e(nlci-2,jj)
-! Characteristics method:
-!alt            ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) &
-!alt                            &           + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) )
+            ! Characteristics method:
+            !alt            ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) &
+            !alt                            &           + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) )
          END DO
       ENDIF
@@ -642,9 +457,9 @@
          DO ji=1,jpi
             ua_e(ji,2) = ubdy_s(ji) * hur_e(ji,2)
-! Specified fluxes:
+            ! Specified fluxes:
             va_e(ji,2) = vbdy_s(ji) * hvr_e(ji,2)
-! Characteristics method:
-!alt            va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) &
-!alt                       &           - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) )
+            ! Characteristics method:
+            !alt            va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) &
+            !alt                       &           - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) )
          END DO
       ENDIF
@@ -653,9 +468,9 @@
          DO ji=1,jpi
             ua_e(ji,nlcj-1) = ubdy_n(ji) * hur_e(ji,nlcj-1)
-! Specified fluxes:
+            ! Specified fluxes:
             va_e(ji,nlcj-2) = vbdy_n(ji) * hvr_e(ji,nlcj-2)
-! Characteristics method:
-!alt            va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2)  + va_e(ji,nlcj-3) &
-!alt                            &           + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) )
+            ! Characteristics method:
+            !alt            va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2)  + va_e(ji,nlcj-3) &
+            !alt                            &           + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) )
          END DO
       ENDIF
@@ -672,9 +487,5 @@
       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
       !!----------------------------------------------------------------------  
 
@@ -682,18 +493,7 @@
 
       ll_int_cons = ln_bt_fw ! Assume conservative temporal integration in
-                             ! the forward case only
-
-      zrhox = Agrif_Rhox()
-      zrhoy = Agrif_Rhoy()
+      ! 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:
@@ -707,5 +507,5 @@
       Agrif_SpecialValue    = 0.e0
       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.
 
@@ -715,333 +515,827 @@
 
       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)
-         
+         ! 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.e0 ; vbdy_w(:) = 0.e0 
+         ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0 
+         ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0 
+         ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0 
+         CALL Agrif_Bc_variable(unb_id,calledweight=zt, procname=interpunb)
+         CALL Agrif_Bc_variable(vnb_id,calledweight=zt, procname=interpvnb)
+      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.e0 ) THEN
+                        tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)
+                     ELSE
+                        tsa(nlci-1,jj,jk,jn)=(zalpha4*tsa(nlci,jj,jk,jn)+zalpha3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)
+                        IF( un(nlci-2,jj,jk) > 0.e0 ) THEN
+                           tsa(nlci-1,jj,jk,jn)=( zalpha6*tsa(nlci-2,jj,jk,jn)+zalpha5*tsa(nlci,jj,jk,jn) & 
+                                 + zalpha7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk)
+                        ENDIF
+                     ENDIF
+                  END DO
+               END DO
+            ENDDO
+         ENDIF
+         ! 
+         IF( northern_side ) THEN            
+            DO jn = 1, jpts
+               tsa(i1:i2,nlcj,k1:k2,jn) = zalpha1 * ptab(i1:i2,nlcj,k1:k2,jn) + zalpha2 * ptab(i1:i2,nlcj-1,k1:k2,jn)
+               DO jk = 1, jpkm1
+                  DO ji = imin,imax
+                     IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN
+                        tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)
+                     ELSE
+                        tsa(ji,nlcj-1,jk,jn)=(zalpha4*tsa(ji,nlcj,jk,jn)+zalpha3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)        
+                        IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN
+                           tsa(ji,nlcj-1,jk,jn)=( zalpha6*tsa(ji,nlcj-2,jk,jn)+zalpha5*tsa(ji,nlcj,jk,jn)  &
+                                 + zalpha7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)
+                        ENDIF
+                     ENDIF
+                  END DO
+               END DO
+            ENDDO
+         ENDIF
+         !
+         IF( western_side) THEN            
+            DO jn = 1, jpts
+               tsa(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn)
+               DO jk = 1, jpkm1
+                  DO jj = jmin,jmax
+                     IF( umask(2,jj,jk) == 0.e0 ) THEN
+                        tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk)
+                     ELSE
+                        tsa(2,jj,jk,jn)=(zalpha4*tsa(1,jj,jk,jn)+zalpha3*tsa(3,jj,jk,jn))*tmask(2,jj,jk)        
+                        IF( un(2,jj,jk) < 0.e0 ) THEN
+                           tsa(2,jj,jk,jn)=(zalpha6*tsa(3,jj,jk,jn)+zalpha5*tsa(1,jj,jk,jn)+zalpha7*tsa(4,jj,jk,jn))*tmask(2,jj,jk)
+                        ENDIF
+                     ENDIF
+                  END DO
+               END DO
+            END DO
+         ENDIF
+         !
+         IF( southern_side ) THEN           
+            DO jn = 1, jpts
+               tsa(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn)
+               DO jk=1,jpk      
+                  DO ji=imin,imax
+                     IF( vmask(ji,2,jk) == 0.e0 ) THEN
+                        tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk)
+                     ELSE
+                        tsa(ji,2,jk,jn)=(zalpha4*tsa(ji,1,jk,jn)+zalpha3*tsa(ji,3,jk,jn))*tmask(ji,2,jk)
+                        IF( vn(ji,2,jk) < 0.e0 ) THEN
+                           tsa(ji,2,jk,jn)=(zalpha6*tsa(ji,3,jk,jn)+zalpha5*tsa(ji,1,jk,jn)+zalpha7*tsa(ji,4,jk,jn))*tmask(ji,2,jk)
+                        ENDIF
+                     ENDIF
+                  END DO
+               END DO
+            ENDDO
+         ENDIF
+         !
+         ! Treatment of corners
+         ! 
+         ! East south
+         IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN
+            tsa(nlci-1,2,:,:) = ptab(nlci-1,2,:,:)
+         ENDIF
+         ! East north
+         IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN
+            tsa(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:)
+         ENDIF
+         ! West south
+         IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN
+            tsa(2,2,:,:) = ptab(2,2,:,:)
+         ENDIF
+         ! West north
+         IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN
+            tsa(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:)
+         ENDIF
+         !
+      ENDIF
+      !
+   END SUBROUTINE interptsn
+
+   SUBROUTINE interpsshn(ptab,i1,i2,j1,j2,before,nb,ndir)
+      !!----------------------------------------------------------------------
+      !!                  ***  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=1,jpk
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  ptab(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk)
+                  ptab(ji,jj,jk) = ptab(ji,jj,jk) * fse3u(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ELSE
+         zrhoy = Agrif_Rhoy()
+         DO jk=1,jpkm1
+            DO jj=j1,j2
+               ua(i1:i2,jj,jk) = (ptab(i1:i2,jj,jk)/(zrhoy*e2u(i1:i2,jj)))
+               ua(i1:i2,jj,jk) = ua(i1:i2,jj,jk) / fse3u(i1:i2,jj,jk)
+            END DO
+         END DO
+      ENDIF
+      ! 
+   END SUBROUTINE interpun
+
+
+   SUBROUTINE interpun2d(ptab,i1,i2,j1,j2,before)
+      !!---------------------------------------------
+      !!   *** ROUTINE interpun ***
+      !!---------------------------------------------    
+      !
+      INTEGER, INTENT(in) :: i1,i2,j1,j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      !
+      INTEGER :: ji,jj
+      REAL(wp) :: ztref
+      REAL(wp) :: zrhoy	
+      !!---------------------------------------------    
+      !
+      ztref = 1.
+
+      IF (before) THEN 
+         DO jj=j1,j2
+            DO ji=i1,MIN(i2,nlci-1)
+               ptab(ji,jj) = e2u(ji,jj) * ((gcx(ji+1,jj) - gcx(ji,jj))/e1u(ji,jj)) 
+            END DO
+         END DO
+      ELSE
+         zrhoy = Agrif_Rhoy()
+         DO jj=j1,j2
+            laplacu(i1:i2,jj) = ztref * (ptab(i1:i2,jj)/(zrhoy*e2u(i1:i2,jj))) !*umask(i1:i2,jj,1)
+         END DO
+      ENDIF
+      ! 
+   END SUBROUTINE interpun2d
+
+
+   SUBROUTINE interpvn(ptab,i1,i2,j1,j2,k1,k2, before)
+      !!---------------------------------------------
+      !!   *** ROUTINE interpvn ***
+      !!---------------------------------------------    
+      !
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      !
+      INTEGER :: ji,jj,jk
+      REAL(wp) :: zrhox	
+      !!---------------------------------------------    
+      !      
+      IF (before) THEN          
+         !interpv entre 1 et k2 et interpv2d en jpkp1
+         DO jk=k1,jpk
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  ptab(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk)
+                  ptab(ji,jj,jk) = ptab(ji,jj,jk) * fse3v(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ELSE          
+         zrhox= Agrif_Rhox()
+         DO jk=1,jpkm1
+            DO jj=j1,j2
+               va(i1:i2,jj,jk) = (ptab(i1:i2,jj,jk)/(zrhox*e1v(i1:i2,jj)))
+               va(i1:i2,jj,jk) = va(i1:i2,jj,jk) / fse3v(i1:i2,jj,jk)
+            END DO
+         END DO
+      ENDIF
+      !        
+   END SUBROUTINE interpvn
+
+   SUBROUTINE interpvn2d(ptab,i1,i2,j1,j2,before)
+      !!---------------------------------------------
+      !!   *** ROUTINE interpvn ***
+      !!---------------------------------------------    
+      !
+      INTEGER, INTENT(in) :: i1,i2,j1,j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      !
+      INTEGER :: ji,jj
+      REAL(wp) :: zrhox	
+      REAL(wp) :: ztref
+      !!---------------------------------------------    
+      ! 
+      ztref = 1.    
+      IF (before) THEN 
+         !interpv entre 1 et k2 et interpv2d en jpkp1
+         DO jj=j1,MIN(j2,nlcj-1)
+            DO ji=i1,i2
+               ptab(ji,jj) = e1v(ji,jj) * ((gcx(ji,jj+1) - gcx(ji,jj))/e2v(ji,jj)) * vmask(ji,jj,1)
+            END DO
+         END DO
+      ELSE           
+         zrhox = Agrif_Rhox()
+         DO ji=i1,i2
+            laplacv(ji,j1:j2) = ztref * (ptab(ji,j1:j2)/(zrhox*e1v(ji,j1:j2)))
+         END DO
+      ENDIF
+      !      
+   END SUBROUTINE interpvn2d
+
+   SUBROUTINE interpunb(ptab,i1,i2,j1,j2,before,nb,ndir)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpunb  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in) :: i1,i2,j1,j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      INTEGER, INTENT(in) :: nb , ndir
+      !!
+      INTEGER :: ji,jj
+      REAL(wp) :: zrhoy, zrhot, zt0, zt1, ztcoeff
+      LOGICAL :: western_side, eastern_side,northern_side,southern_side
+      !!----------------------------------------------------------------------  
+      !
+      IF (before) THEN 
+         DO jj=j1,j2
+            DO ji=i1,i2
+               ptab(ji,jj) = un_b(ji,jj) * e2u(ji,jj) * hu(ji,jj) 
+            END DO
+         END DO
+      ELSE
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+         zrhoy = Agrif_Rhoy()
+         zrhot = Agrif_rhot()
+         ! Time indexes bounds for integration
+         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot
+         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot      
+         ! Polynomial interpolation coefficients:
+         IF( bdy_tinterp == 1 ) THEN
+            ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        &
+                  &      - zt0**2._wp * (       zt0 - 1._wp)        )
+         ELSEIF( bdy_tinterp == 2 ) THEN
+            ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp &
+                  &      - zt0        * (       zt0 - 1._wp)**2._wp ) 
+
+         ELSE
+            ztcoeff = 1
+         ENDIF
+         !   
+         IF(western_side) THEN
+            ubdy_w(j1:j2) = ubdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2)  
+         ENDIF
+         IF(eastern_side) THEN
+            ubdy_e(j1:j2) = ubdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2)  
+         ENDIF
+         IF(southern_side) THEN
+            ubdy_s(i1:i2) = ubdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1) 
+         ENDIF
+         IF(northern_side) THEN
+            ubdy_n(i1:i2) = ubdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 
+         ENDIF
+         !            
+         IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN
+            IF(western_side) THEN
+               ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i1,j1:j2))   &
+                     &                                  * umask(i1,j1:j2,1)
+            ENDIF
+            IF(eastern_side) THEN
+               ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i1,j1:j2))   &
+                     &                                  * umask(i1,j1:j2,1)
+            ENDIF
+            IF(southern_side) THEN
+               ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j1))   &
+                     &                                  * umask(i1:i2,j1,1)
+            ENDIF
+            IF(northern_side) THEN
+               ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1))   &
+                     &                                  * umask(i1:i2,j1,1)
+            ENDIF
+         ENDIF
+      ENDIF
+      ! 
+   END SUBROUTINE interpunb
+
+   SUBROUTINE interpvnb(ptab,i1,i2,j1,j2,before,nb,ndir)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpvnb  ***
+      !!----------------------------------------------------------------------  
+      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 
+         DO jj=j1,j2
+            DO ji=i1,i2
+               ptab(ji,jj) = vn_b(ji,jj) * e1v(ji,jj) * hv(ji,jj) 
+            END DO
+         END DO
+      ELSE
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+         zrhox = Agrif_Rhox()
+         zrhot = Agrif_rhot()
+         ! Time indexes bounds for integration
+         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot
+         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot      
+         IF( bdy_tinterp == 1 ) THEN
+            ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        &
+                  &      - zt0**2._wp * (       zt0 - 1._wp)        )
+         ELSEIF( bdy_tinterp == 2 ) THEN
+            ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp &
+                  &      - zt0        * (       zt0 - 1._wp)**2._wp ) 
+
+         ELSE
+            ztcoeff = 1
+         ENDIF
+         !
+         IF(western_side) THEN
+            vbdy_w(j1:j2) = vbdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2)  
+         ENDIF
+         IF(eastern_side) THEN
+            vbdy_e(j1:j2) = vbdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2)  
+         ENDIF
+         IF(southern_side) THEN
+            vbdy_s(i1:i2) = vbdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1)
+         ENDIF
+         IF(northern_side) THEN
+            vbdy_n(i1:i2) = vbdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 
+         ENDIF
+         !            
+         IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN
+            IF(western_side) THEN
+               vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i1,j1:j2))   &
+                     &                                  * vmask(i1,j1:j2,1)
+            ENDIF
+            IF(eastern_side) THEN
+               vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i1,j1:j2))   &
+                     &                                  * vmask(i1,j1:j2,1)
+            ENDIF
+            IF(southern_side) THEN
+               vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j1))   &
+                     &                                  * vmask(i1:i2,j1,1)
+            ENDIF
+            IF(northern_side) THEN
+               vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1))   &
+                     &                                  * vmask(i1:i2,j1,1)
+            ENDIF
+         ENDIF
+      ENDIF
+      !
+   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
+         DO jj=j1,j2
+            DO ji=i1,i2
+               ptab(ji,jj) = ub2_b(ji,jj) * e2u(ji,jj)
+            END DO
+         END DO
+      ELSE
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+         zrhot = Agrif_rhot()
          ! Time indexes bounds for integration
          zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot
          zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot
-
          ! Polynomial interpolation coefficients:
-         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
+               &      - 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
-      !!----------------------------------------------------------------------  
-
-      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
+      REAL(wp) :: zrhot, zt0, zt1,zat
+      LOGICAL :: western_side, eastern_side,northern_side,southern_side
+      !!----------------------------------------------------------------------  
+      !
+      IF( before ) THEN
          DO jj=j1,j2
             DO ji=i1,i2
-               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  ***
-      !!----------------------------------------------------------------------  
+               ptab(ji,jj) = vb2_b(ji,jj) * e1v(ji,jj)
+            END DO
+         END DO
+      ELSE      
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+         zrhot = Agrif_rhot()
+         ! Time indexes bounds for integration
+         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot
+         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot
+         ! Polynomial interpolation coefficients:
+         zat = zrhot * (  zt1**2._wp * (-2._wp*zt1 + 3._wp)        &
+               &      - zt0**2._wp * (-2._wp*zt0 + 3._wp)        ) 
+         !
+         IF(western_side ) vbdy_w(j1:j2) = zat * ptab(i1,j1:j2)  
+         IF(eastern_side ) vbdy_e(j1:j2) = zat * ptab(i1,j1:j2)  
+         IF(southern_side) vbdy_s(i1:i2) = zat * ptab(i1:i2,j1) 
+         IF(northern_side) vbdy_n(i1:i2) = zat * ptab(i1:i2,j1) 
+      ENDIF
+      !      
+   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) :: tabres
-      !!
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL :: 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
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  ptab(ji,jj,jk) = tmask(ji,jj,jk) * e3t_0(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ELSE
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  ! Get velocity mask at boundary edge points:
+                  IF (western_side)  ztmpmsk = umask(ji    ,jj    ,1)
+                  IF (eastern_side)  ztmpmsk = umask(nlci-2,jj    ,1)
+                  IF (northern_side) ztmpmsk = vmask(ji    ,nlcj-2,1)
+                  IF (southern_side) ztmpmsk = vmask(ji    ,2     ,1)
+
+                  IF (ABS(ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk))*ztmpmsk > 1.D-2) THEN
+                     IF (western_side) THEN
+                        WRITE(numout,*) 'ERROR bathymetry merge at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
+                     ELSEIF (eastern_side) THEN
+                        WRITE(numout,*) 'ERROR bathymetry merge at the eastern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
+                     ELSEIF (southern_side) THEN
+                        WRITE(numout,*) 'ERROR bathymetry merge at the southern border ji,jj,jk', ji+nimpp-1,jj+njmpp-1,jk
+                     ELSEIF (northern_side) THEN
+                        WRITE(numout,*) 'ERROR bathymetry merge at the northen border ji,jj,jk', ji+nimpp-1,jj+njmpp-1,jk
+                     ENDIF
+                     WRITE(numout,*) '      ptab(ji,jj,jk), fse3t(ji,jj,jk) ', ptab(ji,jj,jk), e3t_0(ji,jj,jk)
+                     kindic_agr = kindic_agr + 1
+                  ENDIF
+               END DO
+            END DO
+         END DO
+
+      ENDIF
+      ! 
+   END SUBROUTINE interpe3t
+
+   SUBROUTINE interpumsk(ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpumsk  ***
+      !!----------------------------------------------------------------------  
+      ! 
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL :: before
+      INTEGER, INTENT(in) :: nb , ndir
+      !
+      INTEGER :: ji, jj, jk
+      LOGICAL :: western_side, eastern_side   
+      !!----------------------------------------------------------------------  
+      !    
+      IF (before) THEN
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  ptab(ji,jj,jk) = umask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ELSE
+
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                   ! Velocity mask at boundary edge points:
+                  IF (ABS(ptab(ji,jj,jk) - umask(ji,jj,jk)) > 1.D-2) THEN
+                     IF (western_side) THEN
+                        WRITE(numout,*) 'ERROR with umask at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
+                        WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), umask(ji,jj,jk)
+                        kindic_agr = kindic_agr + 1
+                     ELSEIF (eastern_side) THEN
+                        WRITE(numout,*) 'ERROR with umask at the eastern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
+                        WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), umask(ji,jj,jk)
+                        kindic_agr = kindic_agr + 1
+                     ENDIF
+                  ENDIF
+               END DO
+            END DO
+         END DO
+
+      ENDIF
+      ! 
+   END SUBROUTINE interpumsk
+
+   SUBROUTINE interpvmsk(ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpvmsk  ***
+      !!----------------------------------------------------------------------  
+      ! 
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL :: before
+      INTEGER, INTENT(in) :: nb , ndir
+      !
+      INTEGER :: ji, jj, jk
+      LOGICAL :: northern_side, southern_side     
+      !!----------------------------------------------------------------------  
+      !    
+      IF (before) THEN
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  ptab(ji,jj,jk) = vmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ELSE
+
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                   ! Velocity mask at boundary edge points:
+                  IF (ABS(ptab(ji,jj,jk) - vmask(ji,jj,jk)) > 1.D-2) THEN
+                     IF (southern_side) THEN
+                        WRITE(numout,*) 'ERROR with vmask at the southern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
+                        WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), vmask(ji,jj,jk)
+                        kindic_agr = kindic_agr + 1
+                     ELSEIF (northern_side) THEN
+                        WRITE(numout,*) 'ERROR with vmask at the northern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
+                        WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), vmask(ji,jj,jk)
+                        kindic_agr = kindic_agr + 1
+                     ENDIF
+                  ENDIF
+               END DO
+            END DO
+         END DO
+
+      ENDIF
+      ! 
+   END SUBROUTINE interpvmsk
+
+# if defined key_zdftke
+
+   SUBROUTINE interpavm(ptab,i1,i2,j1,j2,k1,k2,before)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interavm  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      !!----------------------------------------------------------------------  
+      !      
+      IF( before) THEN
+         ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2)
+      ELSE
+         avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)
+      ENDIF
+      !
+   END SUBROUTINE interpavm
+
+# endif /* key_zdftke */
 
 #else
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90	(revision 6440)
@@ -1,5 +1,5 @@
 #define SPONGE && define SPONGE_TOP
 
-Module agrif_opa_sponge
+MODULE agrif_opa_sponge
 #if defined key_agrif  && ! defined key_offline
    USE par_oce
@@ -9,11 +9,13 @@
    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
+   PUBLIC Agrif_Sponge, Agrif_Sponge_Tra, Agrif_Sponge_Dyn
+   PUBLIC interptsn_sponge, interpun_sponge, interpvn_sponge
+
+   !! * Substitutions
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
@@ -23,5 +25,5 @@
    !!----------------------------------------------------------------------
 
-   CONTAINS
+CONTAINS
 
    SUBROUTINE Agrif_Sponge_Tra
@@ -30,55 +32,17 @@
       !!---------------------------------------------
       !!
-      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
 
@@ -90,89 +54,21 @@
       !!---------------------------------------------
       !!
-      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
 
@@ -199,11 +95,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 +149,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 +165,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
       !
@@ -357,36 +186,277 @@
    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) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk)
+                     zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk)
+                     ztu(ji,jj,jk) = zabe1 * ( tsbdiff(ji+1,jj  ,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 
+                     ztv(ji,jj,jk) = zabe2 * ( tsbdiff(ji  ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) )
+                  ENDDO
+               ENDDO
+
+               IF( ln_zps ) THEN      ! set gradient at partial step level
+                  DO jj = j1,j2-1
+                     DO ji = i1,i2-1
+                        ! last level
+                        iku = mbku(ji,jj)
+                        ikv = mbkv(ji,jj)
+                        IF( iku == jk ) THEN
+                           ztu(ji,jj,jk) = 0._wp
+                        ENDIF
+                        IF( ikv == jk ) THEN
+                           ztv(ji,jj,jk) = 0._wp
+                        ENDIF
+                     END DO
+                  END DO
+               ENDIF
+            ENDDO
+
+            DO jk = 1, jpkm1
+               DO jj = j1+1,j2-1
+                  DO ji = i1+1,i2-1
+
+                     IF (.NOT. tabspongedone_tsn(ji,jj)) THEN 
+                        zbtr = r1_e12t(ji,jj) / fse3t_n(ji,jj,jk)
+                        ! horizontal diffusive trends
+                        ztsa = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk)  )
+                        ! add it to the general tracer trends
+                        tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + ztsa
+                     ENDIF
+
+                  ENDDO
+               ENDDO
+
+            ENDDO
+         ENDDO
+
+         tabspongedone_tsn(i1+1:i2-1,j1+1:j2-1) = .TRUE.
+
+      ENDIF
+
+   END SUBROUTINE interptsn_sponge
+
+   SUBROUTINE interpun_sponge(tabres,i1,i2,j1,j2,k1,k2, before)
+      !!---------------------------------------------
+      !!   *** ROUTINE interpun_sponge ***
+      !!---------------------------------------------    
       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_e12t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj)
+                  hdivdiff(ji,jj,jk) = (  e2u(ji  ,jj)*fse3u_n(ji  ,jj,jk) * ubdiff(ji  ,jj,jk) &
+                                     &   -e2u(ji-1,jj)*fse3u_n(ji-1,jj,jk) * ubdiff(ji-1,jj,jk) ) * zbtr
+               END DO
+            END DO
+
+            DO jj = j1,j2-1
+               DO ji = i1,i2   ! vector opt.
+                  zbtr = r1_e12f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj)
+                  rotdiff(ji,jj,jk) = (-e1u(ji,jj+1) * ubdiff(ji,jj+1,jk) &
+                                       +e1u(ji,jj  ) * ubdiff(ji,jj  ,jk) & 
+                                    & ) * fmask(ji,jj,jk) * zbtr 
+               END DO
+            END DO
+         ENDDO
+
+         !
+
+
+
+         DO jj = j1+1, j2-1
+            DO ji = i1+1, i2-1   ! vector opt.
+
+               IF (.NOT. tabspongedone_u(ji,jj)) THEN
+                  DO jk = 1, jpkm1                                 ! Horizontal slab
+                     ze2u = rotdiff (ji,jj,jk)
+                     ze1v = hdivdiff(ji,jj,jk)
+                     ! horizontal diffusive trends
+                     zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * fse3u_n(ji,jj,jk) )   &
+                           + ( hdivdiff(ji+1,jj,jk) - ze1v  ) / e1u(ji,jj)
+
+                     ! add it to the general momentum trends
+                     ua(ji,jj,jk) = ua(ji,jj,jk) + zua
+
+                  END DO
+               ENDIF
+
+            END DO
+         END DO
+
+         tabspongedone_u(i1+1:i2-1,j1+1:j2-1) = .TRUE.
+
+         jmax = j2-1
+         IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,nlcj-3)
+
+         DO jj = j1+1, jmax
+            DO ji = i1+1, i2   ! vector opt.
+
+               IF (.NOT. tabspongedone_v(ji,jj)) THEN
+                  DO jk = 1, jpkm1                                 ! Horizontal slab
+                     ze2u = rotdiff (ji,jj,jk)
+                     ze1v = hdivdiff(ji,jj,jk)
+
+                     ! horizontal diffusive trends
+                     zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * fse3v_n(ji,jj,jk) )   &
+                           + ( hdivdiff(ji,jj+1,jk) - ze1v  ) / e2v(ji,jj)
+
+                     ! add it to the general momentum trends
+                     va(ji,jj,jk) = va(ji,jj,jk) + zva
+                  END DO
+               ENDIF
+
+            END DO
+         END DO
+
+
+         tabspongedone_v(i1+1:i2,j1+1:jmax) = .TRUE.
+
+      ENDIF
+
+
+   END SUBROUTINE interpun_sponge
+
+
+   SUBROUTINE interpvn_sponge(tabres,i1,i2,j1,j2,k1,k2, before,nb,ndir)
+      !!---------------------------------------------
+      !!   *** ROUTINE interpvn_sponge ***
+      !!--------------------------------------------- 
       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_e12t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj)
+                  hdivdiff(ji,jj,jk) = ( e1v(ji,jj  ) * fse3v(ji,jj  ,jk) * vbdiff(ji,jj  ,jk)  &
+                                     &  -e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * vbdiff(ji,jj-1,jk)  ) * zbtr
+               END DO
+            END DO
+            DO jj = j1,j2
+               DO ji = i1,i2-1   ! vector opt.
+                  zbtr = r1_e12f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj)
+                  rotdiff(ji,jj,jk) = ( e2v(ji+1,jj) * vbdiff(ji+1,jj,jk) & 
+                                    &  -e2v(ji  ,jj) * vbdiff(ji  ,jj,jk) &
+                                    & ) * fmask(ji,jj,jk) * zbtr
+               END DO
+            END DO
+         ENDDO
+
+         !                                                ! ===============
+         !                                                
+
+         imax = i2-1
+         IF ((nbondi == 1).OR.(nbondi == 2)) imax = MIN(imax,nlci-3)
+
+         DO jj = j1+1, j2
+            DO ji = i1+1, imax   ! vector opt.
+               IF (.NOT. tabspongedone_u(ji,jj)) THEN
+                  DO jk = 1, jpkm1                                 ! Horizontal slab
+                     ze2u = rotdiff (ji,jj,jk)
+                     ze1v = hdivdiff(ji,jj,jk)
+                     ! horizontal diffusive trends
+                     zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * fse3u_n(ji,jj,jk) ) + ( hdivdiff(ji+1,jj,jk) - ze1v) &
+                           / e1u(ji,jj)
+
+
+                     ! add it to the general momentum trends
+                     ua(ji,jj,jk) = ua(ji,jj,jk) + zua
+                  END DO
+
+               ENDIF
+            END DO
+         END DO
+
+         tabspongedone_u(i1+1:imax,j1+1:j2) = .TRUE.
+
+         DO jj = j1+1, j2-1
+            DO ji = i1+1, i2-1   ! vector opt.
+               IF (.NOT. tabspongedone_v(ji,jj)) THEN
+                  DO jk = 1, jpkm1                                 ! Horizontal slab
+                     ze2u = rotdiff (ji,jj,jk)
+                     ze1v = hdivdiff(ji,jj,jk)
+                     ! horizontal diffusive trends
+
+                     zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * fse3v_n(ji,jj,jk) ) + ( hdivdiff(ji,jj+1,jk) - ze1v) &
+                           / e2v(ji,jj)
+
+                     ! add it to the general momentum trends
+                     va(ji,jj,jk) = va(ji,jj,jk) + zva
+                  END DO
+               ENDIF
+            END DO
+         END DO
+         tabspongedone_v(i1+1:i2-1,j1+1:j2-1) = .TRUE.
+      ENDIF
+
+   END SUBROUTINE interpvn_sponge
 
 #else
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90	(revision 6440)
@@ -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
@@ -11,14 +12,15 @@
    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)
@@ -27,98 +29,151 @@
 CONTAINS
 
-   SUBROUTINE Agrif_Update_Tra( kt )
+   RECURSIVE SUBROUTINE Agrif_Update_Tra( )
       !!---------------------------------------------
       !!   *** ROUTINE Agrif_Update_Tra ***
       !!---------------------------------------------
-      !!
-      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_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
-         CALL Agrif_Update_Variable(ztab,tsn_id, procname=updateTS)
-      ELSE
-         CALL Agrif_Update_Variable(ztab,tsn_id,locupdate=(/0,2/), procname=updateTS)
-      ENDIF
-
+# 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.
-
-      CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztab )
+      !
+      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
 
-   SUBROUTINE Agrif_Update_Dyn( kt )
+   RECURSIVE SUBROUTINE Agrif_Update_Dyn( )
       !!---------------------------------------------
       !!   *** 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 (Agrif_Root()) RETURN
+      !
 #if defined TWO_WAY
-      CALL wrk_alloc( jpi, jpj,      ztab2d )
-      CALL wrk_alloc( jpi, jpj, jpk, ztab   )
-
+      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
-         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 ! defined DECAL_FEEDBACK
+         CALL Agrif_Update_Variable(un_update_id,procname = updateU)
+         CALL Agrif_Update_Variable(vn_update_id,procname = updateV)
+# else
+         CALL Agrif_Update_Variable(un_update_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateU)
+         CALL Agrif_Update_Variable(vn_update_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updateV)
+# endif
+      ELSE
+# if ! defined DECAL_FEEDBACK
+         CALL Agrif_Update_Variable(un_update_id,locupdate=(/0,1/),procname = updateU)
+         CALL Agrif_Update_Variable(vn_update_id,locupdate=(/0,1/),procname = updateV)         
+# else
+         CALL Agrif_Update_Variable(un_update_id,locupdate1=(/0,1/),locupdate2=(/1,1/),procname = updateU)
+         CALL Agrif_Update_Variable(vn_update_id,locupdate1=(/1,1/),locupdate2=(/0,1/),procname = updateV)
+# endif
+      ENDIF
+
+# if ! defined DECAL_FEEDBACK
+      CALL Agrif_Update_Variable(e1u_id,procname = updateU2d)
+      CALL Agrif_Update_Variable(e2v_id,procname = updateV2d)  
+# else
+      CALL Agrif_Update_Variable(e1u_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateU2d)
+      CALL Agrif_Update_Variable(e2v_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updateV2d)  
+# endif
+
+# if defined key_dynspg_ts
       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)
+#  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
-            CALL Agrif_Update_Variable(ztab2d,ub2b_id,locupdate=(/0,1/),procname = updateub2b)
-            CALL Agrif_Update_Variable(ztab2d,vb2b_id,locupdate=(/0,1/),procname = updatevb2b)
+#  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 
+      END IF
+# endif
+      !
+      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
-
-      nbcline = nbcline + 1
-
-      Agrif_UseSpecialValueInUpdate = .TRUE. 
+      !
+      ! 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
+      !       
+      IF( ( Agrif_NbStepint() .NE. 0 ) .AND. (kt /= 0) ) RETURN
+#  if defined TWO_WAY
+
+      Agrif_UseSpecialValueInUpdate = .TRUE.
       Agrif_SpecialValueFineGrid = 0.
-      CALL Agrif_Update_Variable(ztab2d,sshn_id,procname = updateSSH)
+
+      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,      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 )
@@ -127,11 +182,11 @@
       !!---------------------------------------------
 #  include "domzgr_substitute.h90"
-
       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
-      LOGICAL, iNTENT(in) :: before
-
+      LOGICAL, INTENT(in) :: before
+      !!
       INTEGER :: ji,jj,jk,jn
-
+      !!---------------------------------------------
+      !
       IF (before) THEN
          DO jn = n1,n2
@@ -146,5 +201,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 +208,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 +216,4 @@
             ENDDO
          ENDIF
-
          DO jn = n1,n2
             DO jk=k1,k2
@@ -174,5 +228,5 @@
          END DO
       ENDIF
-
+      ! 
    END SUBROUTINE updateTS
 
@@ -182,12 +236,13 @@
       !!---------------------------------------------
 #  include "domzgr_substitute.h90"
-
+      !!
       INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
       LOGICAL, INTENT(in) :: before
-
+      !! 
       INTEGER :: ji, jj, jk
       REAL(wp) :: zrhoy
-
+      !!---------------------------------------------
+      ! 
       IF (before) THEN
          zrhoy = Agrif_Rhoy()
@@ -209,5 +264,5 @@
                   IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part
                      ub(ji,jj,jk) = ub(ji,jj,jk) & 
-                       & + atfp * ( tabres(ji,jj,jk) - un(ji,jj,jk) ) * umask(ji,jj,jk)
+                           & + atfp * ( tabres(ji,jj,jk) - un(ji,jj,jk) ) * umask(ji,jj,jk)
                   ENDIF
                   !
@@ -217,5 +272,5 @@
          END DO
       ENDIF
-
+      ! 
    END SUBROUTINE updateu
 
@@ -225,12 +280,13 @@
       !!---------------------------------------------
 #  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()
@@ -252,5 +308,5 @@
                   IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part
                      vb(ji,jj,jk) = vb(ji,jj,jk) & 
-                       & + atfp * ( tabres(ji,jj,jk) - vn(ji,jj,jk) ) * vmask(ji,jj,jk)
+                           & + atfp * ( tabres(ji,jj,jk) - vn(ji,jj,jk) ) * vmask(ji,jj,jk)
                   ENDIF
                   !
@@ -260,5 +316,5 @@
          END DO
       ENDIF
-
+      ! 
    END SUBROUTINE updatev
 
@@ -268,13 +324,14 @@
       !!---------------------------------------------
 #  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()
@@ -326,5 +383,5 @@
          END DO
       ENDIF
-
+      !
    END SUBROUTINE updateu2d
 
@@ -333,13 +390,13 @@
       !!          *** ROUTINE updatev2d ***
       !!---------------------------------------------
-
       INTEGER, INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
       LOGICAL, INTENT(in) :: before
-
+      !! 
       INTEGER :: ji, jj, jk
       REAL(wp) :: zrhox
       REAL(wp) :: zcorr
-
+      !!---------------------------------------------
+      !
       IF (before) THEN
          zrhox = Agrif_Rhox()
@@ -391,19 +448,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,11 +470,10 @@
          END DO
       ELSE
-
 #if ! defined key_dynspg_ts
          IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN
             DO jj=j1,j2
                DO ji=i1,i2
-                sshb(ji,jj) =   sshb(ji,jj) &
-                 & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1)
+                  sshb(ji,jj) =   sshb(ji,jj) &
+                        & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1)
                END DO
             END DO
@@ -430,5 +486,5 @@
          END DO
       ENDIF
-
+      !
    END SUBROUTINE updateSSH
 
@@ -437,12 +493,12 @@
       !!          *** ROUTINE updateub2b ***
       !!---------------------------------------------
-
       INTEGER, INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
       LOGICAL, INTENT(in) :: before
-
+      !!
       INTEGER :: ji, jj
       REAL(wp) :: zrhoy
-
+      !!---------------------------------------------
+      !
       IF (before) THEN
          zrhoy = Agrif_Rhoy()
@@ -460,5 +516,5 @@
          END DO
       ENDIF
-
+      !
    END SUBROUTINE updateub2b
 
@@ -467,12 +523,12 @@
       !!          *** ROUTINE updatevb2b ***
       !!---------------------------------------------
-
       INTEGER, INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
       LOGICAL, INTENT(in) :: before
-
+      !!
       INTEGER :: ji, jj
       REAL(wp) :: zrhox
-
+      !!---------------------------------------------
+      !
       IF (before) THEN
          zrhox = Agrif_Rhox()
@@ -490,6 +546,112 @@
          END DO
       ENDIF
-
+      !
    END SUBROUTINE updatevb2b
+
+
+   SUBROUTINE update_scales( tabres, i1, i2, j1, j2, k1, k2, n1,n2, before )
+      ! currently not used
+      !!---------------------------------------------
+      !!           *** ROUTINE updateT ***
+      !!---------------------------------------------
+#  include "domzgr_substitute.h90"
+
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
+      LOGICAL, iNTENT(in) :: before
+
+      INTEGER :: ji,jj,jk
+      REAL(wp) :: ztemp
+
+      IF (before) THEN
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  tabres(ji,jj,jk,1) = e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk)
+                  tabres(ji,jj,jk,2) = e1t(ji,jj)*tmask(ji,jj,jk)
+                  tabres(ji,jj,jk,3) = e2t(ji,jj)*tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         tabres(:,:,:,1)=tabres(:,:,:,1)*Agrif_Rhox()*Agrif_Rhoy()
+         tabres(:,:,:,2)=tabres(:,:,:,2)*Agrif_Rhox()
+         tabres(:,:,:,3)=tabres(:,:,:,3)*Agrif_Rhoy()
+      ELSE
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  IF( tabres(ji,jj,jk,1) .NE. 0. ) THEN 
+                     print *,'VAL = ',ji,jj,jk,tabres(ji,jj,jk,1),e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk)
+                     print *,'VAL2 = ',ji,jj,jk,tabres(ji,jj,jk,2),e1t(ji,jj)*tmask(ji,jj,jk)
+                     print *,'VAL3 = ',ji,jj,jk,tabres(ji,jj,jk,3),e2t(ji,jj)*tmask(ji,jj,jk)
+                     ztemp = sqrt(tabres(ji,jj,jk,1)/(tabres(ji,jj,jk,2)*tabres(ji,jj,jk,3)))
+                     print *,'CORR = ',ztemp-1.
+                     print *,'NEW VALS = ',tabres(ji,jj,jk,2)*ztemp,tabres(ji,jj,jk,3)*ztemp, &
+                           tabres(ji,jj,jk,2)*ztemp*tabres(ji,jj,jk,3)*ztemp
+                     e1t(ji,jj) = tabres(ji,jj,jk,2)*ztemp
+                     e2t(ji,jj) = tabres(ji,jj,jk,3)*ztemp
+                  END IF
+               END DO
+            END DO
+         END DO
+      ENDIF
+      !
+   END SUBROUTINE update_scales
+
+# if defined key_zdftke
+   SUBROUTINE updateEN( ptab, i1, i2, j1, j2, k1, k2, before )
+      !!---------------------------------------------
+      !!           *** ROUTINE updateen ***
+      !!---------------------------------------------
+      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      !!---------------------------------------------
+      !
+      IF (before) THEN
+         ptab (i1:i2,j1:j2,k1:k2) = en(i1:i2,j1:j2,k1:k2)
+      ELSE
+         en(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 
+      ENDIF
+      !
+   END SUBROUTINE updateEN
+
+
+   SUBROUTINE updateAVT( ptab, i1, i2, j1, j2, k1, k2, before )
+      !!---------------------------------------------
+      !!           *** ROUTINE updateavt ***
+      !!---------------------------------------------
+      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      !!---------------------------------------------
+      !
+      IF (before) THEN
+         ptab (i1:i2,j1:j2,k1:k2) = avt_k(i1:i2,j1:j2,k1:k2)
+      ELSE
+         avt_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 
+      ENDIF
+      !
+   END SUBROUTINE updateAVT
+
+
+   SUBROUTINE updateAVM( ptab, i1, i2, j1, j2, k1, k2, before )
+      !!---------------------------------------------
+      !!           *** ROUTINE updateavm ***
+      !!---------------------------------------------
+      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      !!---------------------------------------------
+      !
+      IF (before) THEN
+         ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2)
+      ELSE
+         avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 
+      ENDIF
+      !
+   END SUBROUTINE updateAVM
+
+# endif /* key_zdftke */ 
 
 #else
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90	(revision 6440)
@@ -7,4 +7,5 @@
    USE agrif_oce
    USE agrif_top_sponge
+   USE par_trc
    USE trc
    USE lib_mpp
@@ -14,10 +15,10 @@
    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)
@@ -28,114 +29,160 @@
    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()
+   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
 
-      alpha1 = ( zrhox - 1. ) * 0.5
-      alpha2 = 1. - alpha1
-
-      alpha3 = ( zrhox - 1. ) / ( zrhox + 1. )
-      alpha4 = 1. - alpha3
-
-      alpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
-      alpha7 =    - ( zrhox - 1. ) / ( zrhox + 3. )
-      alpha5 = 1. - alpha6 - alpha7
-      IF( nbondi == 1 .OR. nbondi == 2 ) THEN
-
-         DO jn = 1, jptra
-            tra(nlci,:,:,jn) = alpha1 * ztra(nlci,:,:,jn) + alpha2 * ztra(nlci-1,:,:,jn)
-            DO jk = 1, jpkm1
-               DO jj = 1, jpj
-                  IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN
-                     tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)
-                  ELSE
-                     tra(nlci-1,jj,jk,jn)=(alpha4*tra(nlci,jj,jk,jn)+alpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)
-                     IF( un(nlci-2,jj,jk) > 0.e0 ) THEN
-                        tra(nlci-1,jj,jk,jn)=( alpha6*tra(nlci-2,jj,jk,jn)+alpha5*tra(nlci,jj,jk,jn)  &
-                           &                 + alpha7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk)
+      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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90	(revision 6440)
@@ -1,7 +1,8 @@
 #define SPONGE_TOP
 
-Module agrif_top_sponge
+MODULE agrif_top_sponge
 #if defined key_agrif && defined key_top
    USE par_oce
+   USE par_trc
    USE oce
    USE dom_oce
@@ -16,71 +17,31 @@
    PRIVATE
 
-   PUBLIC Agrif_Sponge_Trc, interptrn
+   PUBLIC Agrif_Sponge_trc, interptrn_sponge
 
-  !! * Substitutions
+   !! * Substitutions
 #  include "domzgr_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_Sponge_Trc
+   SUBROUTINE Agrif_Sponge_trc
       !!---------------------------------------------
       !!   *** ROUTINE Agrif_Sponge_Trc ***
       !!---------------------------------------------
       !! 
-      INTEGER :: ji,jj,jk,jn
       REAL(wp) :: timecoeff
-      REAL(wp) :: ztra, zabe1, zabe2, zbtr
-      REAL(wp), POINTER, DIMENSION(:,:) :: ztru, ztrv
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztabr
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: trbdiff
 
 #if defined SPONGE_TOP
-      CALL wrk_alloc( jpi, jpj, ztru, ztrv )
-      CALL wrk_alloc( jpi, jpj, jpk, jptra, ztabr, trbdiff )
-
       timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
-
+      CALL Agrif_sponge
       Agrif_SpecialValue=0.
       Agrif_UseSpecialValue = .TRUE.
-      ztabr = 0.e0
-      CALL Agrif_Bc_Variable(ztabr, tra_id,calledweight=timecoeff,procname=interptrn)
+      tabspongedone_trn = .FALSE.
+      CALL Agrif_Bc_Variable(trn_sponge_id,calledweight=timecoeff,procname=interptrn_sponge)
       Agrif_UseSpecialValue = .FALSE.
-
-      trbdiff(:,:,:,:) = trb(:,:,:,:) - ztabr(:,:,:,:)
-
-      CALL Agrif_sponge
-
-      DO jn = 1, jptra
-         DO jk = 1, jpkm1
-            !
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk)
-                  zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk)
-                  ztru(ji,jj) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jn) - trbdiff(ji,jj,jk,jn) )
-                  ztrv(ji,jj) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) )
-               ENDDO
-            ENDDO
-
-            DO jj = 2,jpjm1
-               DO ji = 2,jpim1
-                  zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk)
-                  ! horizontal diffusive trends
-                  ztra = zbtr * ( ztru(ji,jj) - ztru(ji-1,jj) + ztrv(ji,jj) - ztrv(ji,jj-1)  )
-                  ! add it to the general tracer trends
-                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
-               END DO
-            END DO
-            !
-         ENDDO
-      ENDDO
- 
-      CALL wrk_dealloc( jpi, jpj, ztru, ztrv )
-      CALL wrk_dealloc( jpi, jpj, jpk, jptra, trbdiff, ztabr )
 
 #endif
@@ -88,14 +49,57 @@
    END SUBROUTINE Agrif_Sponge_Trc
 
-   SUBROUTINE interptrn(tabres,i1,i2,j1,j2,k1,k2,n1,n2)
+   SUBROUTINE interptrn_sponge(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before)
       !!---------------------------------------------
-      !!   *** ROUTINE interptn ***
+      !!   *** 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) :: ztra, zabe1, zabe2, zbtr
+      REAL(wp), DIMENSION(i1:i2,j1:j2) :: ztu, ztv
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::trbdiff
       !
-      tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2)
+      IF (before) THEN
+         tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2)
+      ELSE      
 
-   END SUBROUTINE interptrn
+         trbdiff(:,:,:,:) = trb(i1:i2,j1:j2,:,:) - tabres(:,:,:,:)      
+         DO jn = 1, jptra
+            DO jk = 1, jpkm1
+
+               DO jj = j1,j2-1
+                  DO ji = i1,i2-1
+                     zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk)
+                     zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk)
+                     ztu(ji,jj) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jn) - trbdiff(ji,jj,jk,jn) )
+                     ztv(ji,jj) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) )
+                  ENDDO
+               ENDDO
+
+               DO jj = j1+1,j2-1
+                  DO ji = i1+1,i2-1
+
+                     IF (.NOT. tabspongedone_trn(ji,jj)) THEN 
+                        zbtr = r1_e12t(ji,jj) / fse3t(ji,jj,jk)
+                        ! horizontal diffusive trends
+                        ztra = zbtr * (  ztu(ji,jj) - ztu(ji-1,jj  ) + ztv(ji,jj) - ztv(ji  ,jj-1)  )
+                        ! add it to the general tracer trends
+                        tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
+                     ENDIF
+
+                  ENDDO
+               ENDDO
+
+            ENDDO
+         ENDDO
+
+         tabspongedone_trn(i1+1:i2-1,j1+1:j2-1) = .TRUE.
+      ENDIF
+      !                 
+   END SUBROUTINE interptrn_sponge
 
 #else
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90	(revision 6440)
@@ -1,3 +1,4 @@
 #define TWO_WAY
+#undef DECAL_FEEDBACK
 
 MODULE agrif_top_update
@@ -8,4 +9,5 @@
    USE dom_oce
    USE agrif_oce
+   USE par_trc
    USE trc
    USE wrk_nemo  
@@ -24,5 +26,5 @@
    !!----------------------------------------------------------------------
 
-   CONTAINS
+CONTAINS
 
    SUBROUTINE Agrif_Update_Trc( kt )
@@ -30,75 +32,65 @@
       !!   *** 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 )
-
+      !!---------------------------------------------
+      ! 
+      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)
+      ! 
+      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)
+   SUBROUTINE updateTRC( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before )
       !!---------------------------------------------
-      !!   *** ROUTINE UpdateTrc ***
+      !!           *** ROUTINE updateT ***
       !!---------------------------------------------
+#  include "domzgr_substitute.h90"
       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
-      REAL, DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
+      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
-            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
+      !!---------------------------------------------
+      !
+      IF (before) THEN
+         DO jn = n1,n2
+            DO jk=k1,k2
+               DO jj=j1,j2
+                  DO ji=i1,i2
+                     ptab(ji,jj,jk,jn) = trn(ji,jj,jk,jn)
+                  END DO
+               END DO
+            END DO
+         END DO
+      ELSE
+         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN
             ! 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)
+            DO jn = n1,n2
+               DO jk=k1,k2
+                  DO jj=j1,j2
+                     DO ji=i1,i2
+                        IF( ptab(ji,jj,jk,jn) .NE. 0. ) THEN
+                           trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) & 
+                                 & + atfp * ( ptab(ji,jj,jk,jn) &
+                                 &             - trn(ji,jj,jk,jn) ) * tmask(ji,jj,jk)
                         ENDIF
                      ENDDO
@@ -107,5 +99,17 @@
             ENDDO
          ENDIF
-
+         DO jn = n1,n2
+            DO jk=k1,k2
+               DO jj=j1,j2
+                  DO ji=i1,i2
+                     IF( ptab(ji,jj,jk,jn) .NE. 0. ) THEN 
+                        trn(ji,jj,jk,jn) = ptab(ji,jj,jk,jn) * tmask(ji,jj,jk)
+                     END IF
+                  END DO
+               END DO
+            END DO
+         END DO
+      ENDIF
+      ! 
    END SUBROUTINE updateTRC
 
@@ -119,3 +123,3 @@
    END SUBROUTINE agrif_top_update_empty
 #endif
-END Module agrif_top_update
+END MODULE agrif_top_update
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/NST_SRC/agrif_user.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/NST_SRC/agrif_user.F90	(revision 6440)
@@ -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"
@@ -120,10 +123,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 +135,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
 
@@ -167,4 +173,5 @@
    USE nemogcm
    USE sol_oce
+   USE lib_mpp
    USE in_out_manager
    USE agrif_opa_update
@@ -174,14 +181,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 +193,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)
+
+#if defined key_dynspg_ts
+   Agrif_UseSpecialValue = .TRUE.
+   CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn )
+
+   Agrif_UseSpecialValue = ln_spc_dyn
+   CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb)
+   CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb)
+   CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b)
+   CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b)
+   ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0 ; hbdy_w(:) =0.e0
+   ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0 ; hbdy_e(:) =0.e0 
+   ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0 ; hbdy_n(:) =0.e0 
+   ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0 ; hbdy_s(:) =0.e0
+#endif
+
+   Agrif_UseSpecialValue = .FALSE. 
+   ! reset velocities to zero
+   ua(:,:,:) = 0.
+   va(:,:,:) = 0.
 
    ! 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 +263,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 +278,47 @@
          ENDIF
       ENDIF
+      ! check if masks and bathymetries match
+      IF(ln_chk_bathy) THEN
+         !
+         IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level()
+         !
+         kindic_agr = 0
+         ! check if umask agree with parent along western and eastern boundaries:
+         CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk)
+         ! check if vmask agree with parent along northern and southern boundaries:
+         CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk)
+	 ! check if tmask and vertical scale factors agree with parent over first two coarse grid points:
+         CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t)
+         !
+         IF (lk_mpp) CALL mpp_sum( kindic_agr )
+         IF( kindic_agr /= 0 ) THEN             		
+            CALL ctl_stop('Child Bathymetry is not correct near boundaries.')
+         ELSE
+            IF(lwp) WRITE(numout,*) 'Child Bathymetry is ok near boundaries.'
+         END IF
+      ENDIF
+      !
    ENDIF
-
-   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 +334,5 @@
    USE par_oce       !   ONLY : jpts
    USE oce
+   USE agrif_oce
    IMPLICIT NONE
    !!----------------------------------------------------------------------
@@ -281,68 +340,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 +476,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 +508,4 @@
    CALL Agrif_Update_lim2(0)
    !
-   DEALLOCATE( zvel, zadv )
-   !
 END SUBROUTINE Agrif_InitValues_cont_lim2
 
@@ -431,19 +536,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 +567,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 +577,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 +590,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 +633,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 +640,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 +650,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 +670,5 @@
    !!----------------------------------------------------------------------
    USE agrif_util
+   USE agrif_oce
    USE dom_oce
    USE trc
@@ -565,24 +678,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 +707,4 @@
    !!   *** ROUTINE Agrif_detect ***
    !!----------------------------------------------------------------------
-   USE Agrif_Types
    !
    INTEGER, DIMENSION(2) :: ksizex
@@ -614,15 +728,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 +750,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 +759,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 +785,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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90	(revision 6440)
@@ -431,10 +431,13 @@
          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,6 +451,4 @@
          ENDIF
       END DO
-      !                                         ! fill sf with slf_i and control print
-      CALL fld_fill( sf_dyn, slf_d, cn_dir, 'dta_dyn_init', 'Data in file', 'namdta_dyn' )
       !
       IF( lk_ldfslp .AND. .NOT.lk_c1d ) THEN                  ! slopes 
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90	(revision 6440)
@@ -658,5 +658,5 @@
 
       DO jk = 1, jpkm1
-         fzptnz(:,:,jk) = eos_fzp( tsn(:,:,jk,jp_sal), fsdept(:,:,jk) )
+        CALL eos_fzp( tsn(:,:,jk,jp_sal), fzptnz(:,:,jk), fsdept(:,:,jk) )
       END DO
 
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90	(revision 6440)
@@ -430,4 +430,5 @@
       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
@@ -669,12 +670,20 @@
             ! sea ice
             IF( nn_ice_lim_dta(ib_bdy) .eq. 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. )
+               ! Test for types of ice input (lim2 or lim3)
+               ! Build file name to find dimensions 
+               clname=TRIM(bn_a_i%clname)
+               IF( .NOT. bn_a_i%ln_clim ) THEN   
+                                                  WRITE(clname, '(a,"_y",i4.4)' ) TRIM( bn_a_i%clname ), nyear    ! add year
+                  IF( bn_a_i%cltype /= 'yearly' ) WRITE(clname, '(a,"m" ,i2.2)' ) TRIM( clname        ), nmonth   ! add month
+               ELSE
+                  IF( bn_a_i%cltype /= 'yearly' ) WRITE(clname, '(a,"_m",i2.2)' ) TRIM( bn_a_i%clname ), nmonth   ! add month
+               ENDIF
+               IF( bn_a_i%cltype == 'daily' .OR. bn_a_i%cltype(1:4) == 'week' ) &
+               &                                  WRITE(clname, '(a,"d" ,i2.2)' ) TRIM( clname        ), nday     ! add day
+               !
+               CALL iom_open  ( clname, inum )
+               id1 = iom_varid( inum, bn_a_i%clvar, kdimsz=zdimsz, kndims=zndims, ldstop = .FALSE. )
                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
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90	(revision 6440)
@@ -49,8 +49,8 @@
       !!----------------------------------------------------------------------
       INTEGER,                      INTENT(in) ::   kt   ! Main time step counter
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d 
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pub2d, pvb2d
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: phur, phvr
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pssh
+      REAL(wp), DIMENSION(:,:), INTENT(inout) :: pua2d, pva2d 
+      REAL(wp), DIMENSION(:,:), INTENT(in   ) :: pub2d, pvb2d
+      REAL(wp), DIMENSION(:,:), INTENT(in   ) :: phur, phvr
+      REAL(wp), DIMENSION(:,:), INTENT(in   ) :: pssh
       !!
       INTEGER                                  ::   ib_bdy ! Loop counter
@@ -92,5 +92,5 @@
       TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
       INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d 
+      REAL(wp), DIMENSION(:,:), INTENT(inout) :: pua2d, pva2d 
       !!
       INTEGER  ::   jb, jk         ! dummy loop indices
@@ -147,6 +147,6 @@
       TYPE(OBC_DATA),               INTENT(in) ::   dta  ! OBC external data
       INTEGER,                      INTENT(in) ::   ib_bdy  ! BDY set index
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pssh, phur, phvr 
+      REAL(wp), DIMENSION(:,:), INTENT(inout) :: pua2d, pva2d
+      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pssh, phur, phvr 
 
       INTEGER  ::   jb, igrd                         ! dummy loop indices
@@ -237,6 +237,6 @@
       TYPE(OBC_DATA),               INTENT(in) ::   dta  ! OBC external data
       INTEGER,                      INTENT(in) ::   ib_bdy  ! number of current open boundary set
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pub2d, pvb2d 
+      REAL(wp), DIMENSION(:,:),     INTENT(inout) :: pua2d, pva2d
+      REAL(wp), DIMENSION(:,:),     INTENT(in) :: pub2d, pvb2d 
       LOGICAL,                      INTENT(in) ::   ll_npo  ! flag for NPO version
 
@@ -271,8 +271,8 @@
       !!
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   zssh ! Sea level
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   zssh ! Sea level
       !!
       INTEGER  ::   ib_bdy, ib, igrd                        ! local integers
-      INTEGER  ::   ii, ij, zcoef, zcoef1, zcoef2, ip, jp   !   "       "
+      INTEGER  ::   ii, ij, zcoef, ip, jp   !   "       "
 
       igrd = 1                       ! Everything is at T-points here
@@ -283,19 +283,7 @@
             ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
             ! Set gradient direction:
-            zcoef1 = bdytmask(ii-1,ij  ) +  bdytmask(ii+1,ij  )
-            zcoef2 = bdytmask(ii  ,ij-1) +  bdytmask(ii  ,ij+1)
-            IF ( zcoef1+zcoef2 == 0 ) THEN
-               ! corner
-!               zcoef = tmask(ii-1,ij,1) + tmask(ii+1,ij,1) +  tmask(ii,ij-1,1) +  tmask(ii,ij+1,1)
-!               zssh(ii,ij) = zssh(ii-1,ij  ) * tmask(ii-1,ij  ,1) + &
-!                 &           zssh(ii+1,ij  ) * tmask(ii+1,ij  ,1) + &
-!                 &           zssh(ii  ,ij-1) * tmask(ii  ,ij-1,1) + &
-!                 &           zssh(ii  ,ij+1) * tmask(ii  ,ij+1,1)
-               zcoef = bdytmask(ii-1,ij) + bdytmask(ii+1,ij) +  bdytmask(ii,ij-1) +  bdytmask(ii,ij+1)
-               zssh(ii,ij) = zssh(ii-1,ij  ) * bdytmask(ii-1,ij  ) + &
-                 &           zssh(ii+1,ij  ) * bdytmask(ii+1,ij  ) + &
-                 &           zssh(ii  ,ij-1) * bdytmask(ii  ,ij-1) + &
-                 &           zssh(ii  ,ij+1) * bdytmask(ii  ,ij+1)
-               zssh(ii,ij) = ( zssh(ii,ij) / MAX( 1, zcoef) ) * tmask(ii,ij,1)
+            zcoef = bdytmask(ii-1,ij) + bdytmask(ii+1,ij) +  bdytmask(ii,ij-1) +  bdytmask(ii,ij+1)
+            IF ( zcoef == 0 ) THEN
+               zssh(ii,ij) = 0._wp
             ELSE
                ip = bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  )
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90	(revision 6440)
@@ -107,4 +107,8 @@
       REAL(wp) ::   zwgt, zwgt1        ! local scalar
       REAL(wp) ::   ztmelts, zdh
+#if  defined key_lim2 && ! defined key_lim2_vp && defined key_agrif
+     USE ice_2, vt_s => hsnm
+     USE ice_2, vt_i => hicm
+#endif
 
       !!------------------------------------------------------------------------------
@@ -115,5 +119,5 @@
       !
 #if defined key_lim2
-      DO jb = 1, idx%nblen(jgrd)
+      DO jb = 1, idx%nblenrim(jgrd)
          ji    = idx%nbi(jb,jgrd)
          jj    = idx%nbj(jb,jgrd)
@@ -135,5 +139,5 @@
 
       DO jl = 1, jpl
-         DO jb = 1, idx%nblen(jgrd)
+         DO jb = 1, idx%nblenrim(jgrd)
             ji    = idx%nbi(jb,jgrd)
             jj    = idx%nbj(jb,jgrd)
@@ -171,5 +175,5 @@
 
       DO jl = 1, jpl
-         DO jb = 1, idx%nblen(jgrd)
+         DO jb = 1, idx%nblenrim(jgrd)
             ji    = idx%nbi(jb,jgrd)
             jj    = idx%nbj(jb,jgrd)
@@ -324,5 +328,5 @@
                
                jgrd = 2      ! u velocity
-               DO jb = 1, idx_bdy(ib_bdy)%nblen(jgrd)
+               DO jb = 1, idx_bdy(ib_bdy)%nblenrim(jgrd)
                   ji    = idx_bdy(ib_bdy)%nbi(jb,jgrd)
                   jj    = idx_bdy(ib_bdy)%nbj(jb,jgrd)
@@ -353,5 +357,5 @@
                
                jgrd = 3      ! v velocity
-               DO jb = 1, idx_bdy(ib_bdy)%nblen(jgrd)
+               DO jb = 1, idx_bdy(ib_bdy)%nblenrim(jgrd)
                   ji    = idx_bdy(ib_bdy)%nbi(jb,jgrd)
                   jj    = idx_bdy(ib_bdy)%nbj(jb,jgrd)
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90	(revision 6440)
@@ -76,5 +76,5 @@
       INTEGER  ::   ib_bdy, ii, ij, ik, igrd, ib, ir, iseg ! dummy loop indices
       INTEGER  ::   icount, icountr, ibr_max, ilen1, ibm1  ! local integers
-      INTEGER  ::   iw, ie, is, in, inum, id_dummy         !   -       -
+      INTEGER  ::   iwe, ies, iso, ino, inum, id_dummy         !   -       -
       INTEGER  ::   igrd_start, igrd_end, jpbdta           !   -       -
       INTEGER  ::   jpbdtau, jpbdtas                       !   -       -
@@ -777,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))
@@ -853,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
@@ -890,4 +890,5 @@
          com_south_b = 0
          com_north_b = 0
+
          DO igrd = 1, jpbgrd
             icount  = 0
@@ -896,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
                      !
@@ -1594,5 +1595,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
@@ -1608,5 +1609,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
@@ -1638,5 +1639,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
@@ -1652,5 +1653,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
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90	(revision 6440)
@@ -416,5 +416,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
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90	(revision 6440)
@@ -91,5 +91,5 @@
       ! Calculate the cumulate surface Flux z_cflxemp (m3/s) over all the domain
       ! -----------------------------------------------------------------------
-      z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:)+rdivisf*fwfisf(:,:) ) * bdytmask(:,:) * e1t(:,:) * e2t(:,:) ) / rau0
+      z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1t(:,:) * e2t(:,:) ) / rau0
       IF( lk_mpp )   CALL mpp_sum( z_cflxemp )     ! sum over the global domain
 
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90	(revision 6440)
@@ -196,9 +196,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)*tmask_i(ji,jj)        
+                     ana_temp(ji,jj,nhc,2) = ana_temp(ji,jj,nhc,2) + ztemp*un_b(ji,jj)*umask_i(ji,jj)
+                     ana_temp(ji,jj,nhc,3) = ana_temp(ji,jj,nhc,3) + ztemp*vn_b(ji,jj)*vmask_i(ji,jj)
                   END DO
                END DO
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90	(revision 6440)
@@ -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
@@ -101,7 +101,6 @@
       ! 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(:,:) )
+          z_frc_trd_t = z_frc_trd_t + glob_sum( risf_tsc(:,:,jp_tem) * surf(:,:) )
+          z_frc_trd_s = z_frc_trd_s + glob_sum( risf_tsc(:,:,jp_sal) * surf(:,:) )
       ENDIF
 
@@ -200,5 +199,4 @@
 !      ENDIF
 !!gm end
-
 
       IF( lk_vvl ) THEN
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90	(revision 6440)
@@ -145,13 +145,18 @@
       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(:,:,:) )
-      ENDIF
+      ! Output of initial vertical scale factor
+      CALL iom_put("e3t_0", e3t_0(:,:,:) )
+      CALL iom_put("e3u_0", e3t_0(:,:,:) )
+      CALL iom_put("e3v_0", e3t_0(:,:,:) )
+      !
+      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( iom_use("e3tdef") )   &
+         CALL iom_put( "e3tdef"  , ( ( fse3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 )
+
 
       CALL iom_put( "ssh" , sshn )                 ! sea surface height
-      if( iom_use('ssh2') )   CALL iom_put( "ssh2", sshn(:,:) * sshn(:,:) )   ! square of sea surface height
       
       CALL iom_put( "toce", tsn(:,:,:,jp_tem) )    ! 3D temperature
@@ -243,4 +248,7 @@
       CALL iom_put( "avm" , avmu                       )    ! T vert. eddy visc. coef.
       CALL iom_put( "avs" , fsavs(:,:,:)               )    ! S vert. eddy diff. coef. (useful only with key_zdfddm)
+                                                            ! Log of eddy diff coef
+      IF( iom_use('logavt') )   CALL iom_put( "logavt", LOG( MAX( 1.e-20_wp, avt  (:,:,:) ) ) )
+      IF( iom_use('logavs') )   CALL iom_put( "logavs", LOG( MAX( 1.e-20_wp, fsavs(:,:,:) ) ) )
 
       IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN
@@ -307,5 +315,7 @@
          CALL iom_put( "eken", rke )           
       ENDIF
-         
+      !
+      CALL iom_put( "hdiv", hdivn )                  ! Horizontal divergence
+      !
       IF( iom_use("u_masstr") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN
          z3d(:,:,jpk) = 0.e0
@@ -438,7 +448,5 @@
       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
@@ -1020,4 +1028,6 @@
          CALL histdef( id_i, "vovvldep", "T point depth"         , "m"      ,   &   ! t-point depth
             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
+         CALL histdef( id_i, "vovvle3t", "T point thickness"         , "m"      ,   &   ! t-point depth
+            &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
       END IF
 
@@ -1050,4 +1060,8 @@
       CALL histwrite( id_i, "sozotaux", kt, utau             , jpi*jpj    , idex )    ! i-wind stress
       CALL histwrite( id_i, "sometauy", kt, vtau             , jpi*jpj    , idex )    ! j-wind stress
+      IF( lk_vvl ) THEN
+         CALL histwrite( id_i, "vovvldep", kt, fsdept_n(:,:,:), jpi*jpj*jpk, idex )!  T-cell depth       
+         CALL histwrite( id_i, "vovvle3t", kt, fse3t_n (:,:,:), jpi*jpj*jpk, idex )!  T-cell thickness  
+      END IF
 
       ! 3. Close the file
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90	(revision 6440)
@@ -73,4 +73,9 @@
       !!----------------------------------------------------------------------
       !
+      ! max number of seconds between each restart
+      IF( REAL( nitend - nit000 + 1 ) * rdt > REAL( HUGE( nsec1jan000 ) ) ) THEN
+         CALL ctl_stop( 'The number of seconds between each restart exceeds the integer 4 max value: 2^31-1. ',   &
+            &           'You must do a restart at higher frequency (or remove this stop and recompile the code in I8)' )
+      ENDIF
       ! all calendar staff is based on the fact that MOD( rday, rdttra(1) ) == 0
       IF( MOD( rday     , rdttra(1) ) /= 0. )   CALL ctl_stop( 'the time step must devide the number of second of in a day' )
@@ -238,9 +243,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
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90	(revision 6440)
@@ -169,40 +169,40 @@
             !
             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
+            ij0 = 241 - 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
+            ij0 = 248 - 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
+            ij0 = 164 - 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
+            ij0 = 164 - 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
+            ij0 = 164 - 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
+            ij0 = 164 - 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
+            ij0 = 181 - 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
+            ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 50.e3
             IF(lwp) WRITE(numout,*)
             IF(lwp) WRITE(numout,*) '             orca_r1: E Halmahera : e1v reduced to 50 km'
@@ -544,5 +544,6 @@
          IF ( cp_cfg == 'eel' .AND. jp_cfg == 6 ) THEN    ! for EEL6 configuration only
             IF( .NOT. Agrif_Root() ) THEN
-              zphi0 = ppgphi0 - FLOAT( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m) / (ra * rad)
+              zphi0 = ppgphi0 - FLOAT( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m)   & 
+                    &           / (ra * rad)
             ENDIF
          ENDIF
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90	(revision 6440)
@@ -413,33 +413,33 @@
          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
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90	(revision 6440)
@@ -665,14 +665,4 @@
          ht(:,:) = ht(:,:) + fse3t_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 (:,:,:) )
-      IF( iom_use("e3tdef") )   &
-         CALL iom_put( "e3tdef"  , ( ( fse3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 )
 
       ! write restart file
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90	(revision 6440)
@@ -215,4 +215,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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90	(revision 6440)
@@ -219,7 +219,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 +242,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 +270,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 )
@@ -1870,7 +1884,8 @@
              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
+             IF( ( + bathy(iim1,ijp1) + bathy(ji,ijp1) + bathy(iip1,ijp1)  &
+                &  + bathy(iim1,jj  )                  + bathy(iip1,jj  )  &
+                &  + bathy(iim1,ijm1) + bathy(ji,ijm1) + bathy(iip1,ijp1)  ) > 0._wp ) THEN
+                zenv(ji,jj) = rn_sbot_min
              ENDIF
            ENDIF
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90	(revision 6440)
@@ -97,6 +97,6 @@
       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 )
+      CALL wrk_alloc( jpi  , jpj+2, zwu  )
+      CALL wrk_alloc( jpi+2, jpj  , zwv  )
       !
       IF( kt == nit000 ) THEN
@@ -236,6 +236,6 @@
       CALL lbc_lnk( hdivn, 'T', 1. )   ;   CALL lbc_lnk( rotn , 'F', 1. )    ! lateral boundary cond. (no sign change)
       !
-      CALL wrk_dealloc( jpi  , jpj+2, zwu               )
-      CALL wrk_dealloc( jpi+4, jpj  , zwv, kistart = -1 )
+      CALL wrk_dealloc( jpi  , jpj+2, zwu )
+      CALL wrk_dealloc( jpi+2, jpj  , zwv )
       !
       IF( nn_timing == 1 )  CALL timing_stop('div_cur')
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90	(revision 6440)
@@ -266,6 +266,18 @@
                ! 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)
+               IF ( nn_isf == 0) THEN   ! if no ice shelf melting
+                  fse3t_b(:,:,1) = fse3t_b(:,:,1) - atfp * rdt * r1_rau0 * ( emp_b(:,:) - emp(:,:) &
+                                 &                                          -rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1)
+               ELSE                     ! if ice shelf melting
+                  DO jj = 1,jpj
+                     DO ji = 1,jpi
+                        jk = mikt(ji,jj)
+                        fse3t_b(ji,jj,jk) = fse3t_b(ji,jj,jk) - atfp * rdt * r1_rau0                       &
+                                          &                          * ( (emp_b(ji,jj)    - emp(ji,jj)   ) &
+                                          &                            - (rnf_b(ji,jj)    - rnf(ji,jj)   ) &
+                                          &                            + (fwfisf_b(ji,jj) - fwfisf(ji,jj)) ) * tmask(ji,jj,jk)
+                     END DO
+                  END DO
+               END IF
             ENDIF
             !
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90	(revision 6440)
@@ -187,5 +187,5 @@
       !
                                      	                ! time offset in steps for bdy data update
-      IF (.NOT.ln_bt_fw) THEN ; noffset=-2*nn_baro ; ELSE ;  noffset = 0 ; ENDIF
+      IF (.NOT.ln_bt_fw) THEN ; noffset=-nn_baro ; ELSE ;  noffset = 0 ; ENDIF
       !
       IF( kt == nit000 ) THEN             	!* initialisation
@@ -454,8 +454,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 +465,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 )
@@ -523,6 +523,6 @@
          ! Update only tidal forcing at open boundaries
 #if defined key_tide
-         IF ( lk_bdy .AND. lk_tide )      CALL bdy_dta_tides( kt, kit=jn, time_offset=(noffset+1) )
-         IF ( ln_tide_pot .AND. lk_tide ) CALL upd_tide( kt, kit=jn, 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
          !
@@ -900,6 +900,5 @@
 #if defined key_agrif
       ! Save time integrated fluxes during child grid integration
-      ! (used to update coarse grid transports)
-      ! Useless with 2nd order momentum schemes
+      ! (used to update coarse grid transports at next time step)
       !
       IF ( (.NOT.Agrif_Root()).AND.(ln_bt_fw) ) THEN
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90	(revision 6440)
@@ -31,5 +31,4 @@
    USE bdydyn2d        ! bdy_ssh routine
 #if defined key_agrif
-   USE agrif_opa_update
    USE agrif_opa_interp
 #endif
@@ -268,12 +267,9 @@
       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(:,:)
+         IF( lk_vvl ) sshb(:,:) = sshb(:,:) - atfp * rdt / rau0 * ( emp_b(:,:)    - emp(:,:)    &
+                                &                                 - rnf_b(:,:)    + rnf(:,:)    &
+                                &                                 + fwfisf_b(:,:) - fwfisf(:,:) ) * ssmask(:,:)
          sshn(:,:) = ssha(:,:)                           ! now <-- after
       ENDIF
-      !
-      ! Update velocity at AGRIF zoom boundaries
-#if defined key_agrif
-      IF ( .NOT.Agrif_Root() ) CALL Agrif_Update_Dyn( kt )
-#endif
       !
       IF(ln_ctl)   CALL prt_ctl( tab2d_1=sshb, clinfo1=' sshb  - : ', mask1=tmask, ovlap=1 )
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90	(revision 6440)
@@ -94,13 +94,21 @@
       CHARACTER(len=*), INTENT(in)  :: cdname
 #if defined key_iomput
-      TYPE(xios_time)   :: dtime    = xios_time(0, 0, 0, 0, 0, 0)
-      CHARACTER(len=19) :: cldate 
-      CHARACTER(len=10) :: clname
-      INTEGER           ::   ji
+#if ! defined key_xios2
+      TYPE(xios_time)     :: dtime    = xios_time(0, 0, 0, 0, 0, 0)
+      CHARACTER(len=19)   :: cldate 
+#else
+      TYPE(xios_duration) :: dtime    = xios_duration(0, 0, 0, 0, 0, 0)
+      TYPE(xios_date)     :: start_date
+#endif
+      CHARACTER(len=10)   :: clname
+      INTEGER             :: ji
       !
       REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_bnds
       !!----------------------------------------------------------------------
-
+#if ! defined key_xios2
       ALLOCATE( z_bnds(jpk,2) )
+#else
+      ALLOCATE( z_bnds(2,jpk) )
+#endif
 
       clname = cdname
@@ -110,4 +118,5 @@
 
       ! calendar parameters
+#if ! defined key_xios2
       SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
       CASE ( 1)   ;   CALL xios_set_context_attr(TRIM(clname), calendar_type= "Gregorian")
@@ -117,6 +126,17 @@
       WRITE(cldate,"(i4.4,'-',i2.2,'-',i2.2,' 00:00:00')") nyear,nmonth,nday 
       CALL xios_set_context_attr(TRIM(clname), start_date=cldate )
-
+#else
+      ! Calendar type is now defined in xml file 
+      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
+      CASE ( 1)   ; CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(1900,01,01,00,00,00), &
+          &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) )
+      CASE ( 0)   ; CALL xios_define_calendar( TYPE = "NoLeap"   , time_origin = xios_date(1900,01,01,00,00,00), &
+          &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) )
+      CASE (30)   ; CALL xios_define_calendar( TYPE = "D360"     , time_origin = xios_date(1900,01,01,00,00,00), &
+          &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) )
+      END SELECT
+#endif
       ! horizontal grid definition
+
       CALL set_scalar
 
@@ -170,14 +190,29 @@
 
       ! Add vertical grid bounds
+#if ! defined key_xios2
       z_bnds(:      ,1) = gdepw_1d(:)
       z_bnds(1:jpkm1,2) = gdepw_1d(2:jpk)
       z_bnds(jpk:   ,2) = gdepw_1d(jpk) + e3t_1d(jpk)
+#else
+      z_bnds(1      ,:) = gdepw_1d(:)
+      z_bnds(2,1:jpkm1) = gdepw_1d(2:jpk)
+      z_bnds(2,jpk:   ) = gdepw_1d(jpk) + e3t_1d(jpk)
+#endif
+
       CALL iom_set_axis_attr( "deptht", bounds=z_bnds )
       CALL iom_set_axis_attr( "depthu", bounds=z_bnds )
       CALL iom_set_axis_attr( "depthv", bounds=z_bnds )
-      z_bnds(:    ,2) = gdept_1d(:)
-      z_bnds(2:jpk,1) = gdept_1d(1:jpkm1)
-      z_bnds(1    ,1) = gdept_1d(1) - e3w_1d(1)
+
+#if ! defined key_xios2
+      z_bnds(:    ,2)  = gdept_1d(:)
+      z_bnds(2:jpk,1)  = gdept_1d(1:jpkm1)
+      z_bnds(1    ,1)  = gdept_1d(1) - e3w_1d(1)
+#else
+      z_bnds(2,:    )  = gdept_1d(:)
+      z_bnds(1,2:jpk)  = gdept_1d(1:jpkm1)
+      z_bnds(1,1    )  = gdept_1d(1) - e3w_1d(1)
+#endif
       CALL iom_set_axis_attr( "depthw", bounds=z_bnds )
+
 
 # if defined key_floats
@@ -1156,6 +1191,11 @@
       REAL(wp), DIMENSION(:)   , OPTIONAL, INTENT(in) ::   lonvalue, latvalue
       REAL(wp), DIMENSION(:,:) , OPTIONAL, INTENT(in) ::   bounds_lon, bounds_lat, area
-      LOGICAL,  DIMENSION(:,:) , OPTIONAL, INTENT(in) ::   mask
-
+#if ! defined key_xios2
+     LOGICAL,  DIMENSION(:,:) , OPTIONAL, INTENT(in) ::   mask
+#else
+      LOGICAL,  DIMENSION(:) , OPTIONAL, INTENT(in) ::   mask
+#endif
+
+#if ! defined key_xios2
       IF ( xios_is_valid_domain     (cdid) ) THEN
          CALL xios_set_domain_attr     ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   &
@@ -1164,6 +1204,5 @@
             &    lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon,                  &
             &    bounds_lat=bounds_lat, area=area )
-      ENDIF
-
+     ENDIF
       IF ( xios_is_valid_domaingroup(cdid) ) THEN
          CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   &
@@ -1173,7 +1212,34 @@
             &    bounds_lat=bounds_lat, area=area )
       ENDIF
+
+#else
+      IF ( xios_is_valid_domain     (cdid) ) THEN
+         CALL xios_set_domain_attr     ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   &
+            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   &
+            &    lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon,                  &
+            &    bounds_lat_1D=bounds_lat, area=area, type='curvilinear')
+     ENDIF
+      IF ( xios_is_valid_domaingroup(cdid) ) THEN
+         CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   &
+            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   &
+            &    lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon,                  &
+            &    bounds_lat_1D=bounds_lat, area=area, type='curvilinear' )
+      ENDIF
+#endif
       CALL xios_solve_inheritance()
 
    END SUBROUTINE iom_set_domain_attr
+
+#if defined key_xios2
+  SUBROUTINE iom_set_zoom_domain_attr( cdid, ibegin, jbegin, ni, nj)
+     CHARACTER(LEN=*)                   , INTENT(in) ::   cdid
+     INTEGER                  , OPTIONAL, INTENT(in) ::   ibegin, jbegin, ni, nj
+
+     IF ( xios_is_valid_zoom_domain     (cdid) ) THEN
+         CALL xios_set_zoom_domain_attr     ( cdid, ibegin=ibegin, jbegin=jbegin, ni=ni,    &
+           &   nj=nj)
+    ENDIF
+  END SUBROUTINE iom_set_zoom_domain_attr
+#endif
 
 
@@ -1183,6 +1249,11 @@
       REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) ::   bounds
       IF ( PRESENT(paxis) ) THEN
+#if ! defined key_xios2
          IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, size=SIZE(paxis), value=paxis )
          IF ( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, size=SIZE(paxis), value=paxis )
+#else
+         IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, n_glo=SIZE(paxis), value=paxis )
+         IF ( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=paxis )
+#endif
       ENDIF
       IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, bounds=bounds )
@@ -1191,14 +1262,19 @@
    END SUBROUTINE iom_set_axis_attr
 
-
    SUBROUTINE iom_set_field_attr( cdid, freq_op, freq_offset )
       CHARACTER(LEN=*)          , INTENT(in) ::   cdid
-      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 ! defined key_xios2
+      CHARACTER(LEN=*)   ,OPTIONAL , INTENT(in) ::   freq_op
+      CHARACTER(LEN=*)   ,OPTIONAL , INTENT(in) ::   freq_offset
+#else
+      TYPE(xios_duration),OPTIONAL , INTENT(in) ::   freq_op
+      TYPE(xios_duration),OPTIONAL , INTENT(in) ::   freq_offset
+#endif
+      IF ( xios_is_valid_field     (cdid) )   CALL xios_set_field_attr       &
+    &     ( cdid, freq_op=freq_op, freq_offset=freq_offset )
+      IF ( xios_is_valid_fieldgroup(cdid) )   CALL xios_set_fieldgroup_attr  &
+    &                    ( cdid, freq_op=freq_op, freq_offset=freq_offset )
       CALL xios_solve_inheritance()
    END SUBROUTINE iom_set_field_attr
-
 
    SUBROUTINE iom_set_file_attr( cdid, name, name_suffix )
@@ -1213,10 +1289,19 @@
    SUBROUTINE iom_get_file_attr( cdid, name, name_suffix, output_freq )
       CHARACTER(LEN=*)          , INTENT(in ) ::   cdid
-      CHARACTER(LEN=*),OPTIONAL , INTENT(out) ::   name, name_suffix, output_freq
+      CHARACTER(LEN=*),OPTIONAL , INTENT(out) ::   name, name_suffix
+#if ! defined key_xios2
+      CHARACTER(LEN=*),OPTIONAL , INTENT(out) ::    output_freq
+#else
+      TYPE(xios_duration)   ,OPTIONAL , INTENT(out) :: output_freq
+#endif  
       LOGICAL                                 ::   llexist1,llexist2,llexist3
       !---------------------------------------------------------------------
       IF( PRESENT( name        ) )   name = ''          ! default values
       IF( PRESENT( name_suffix ) )   name_suffix = ''
+#if ! defined key_xios2
       IF( PRESENT( output_freq ) )   output_freq = ''
+#else
+      IF( PRESENT( output_freq ) )   output_freq = xios_duration(0,0,0,0,0,0)
+#endif
       IF ( xios_is_valid_file     (cdid) ) THEN
          CALL xios_solve_inheritance()
@@ -1239,6 +1324,11 @@
       CHARACTER(LEN=*)                   , INTENT(in) ::   cdid
       LOGICAL, DIMENSION(:,:,:), OPTIONAL, INTENT(in) ::   mask
+#if ! defined key_xios2
       IF ( xios_is_valid_grid     (cdid) )   CALL xios_set_grid_attr     ( cdid, mask=mask )
       IF ( xios_is_valid_gridgroup(cdid) )   CALL xios_set_gridgroup_attr( cdid, mask=mask )
+#else
+      IF ( xios_is_valid_grid     (cdid) )   CALL xios_set_grid_attr     ( cdid, mask_3D=mask )
+      IF ( xios_is_valid_gridgroup(cdid) )   CALL xios_set_gridgroup_attr( cdid, mask_3D=mask )
+#endif
       CALL xios_solve_inheritance()
    END SUBROUTINE iom_set_grid_attr
@@ -1282,5 +1372,9 @@
       ni=nlei-nldi+1 ; nj=nlej-nldj+1
 
-      CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj)
+#if ! defined key_xios2
+     CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj)
+#else
+     CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj)
+#endif     
       CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)
       CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)),   &
@@ -1296,5 +1390,9 @@
          END SELECT
          !
+#if ! defined key_xios2
          CALL iom_set_domain_attr( "grid_"//cdgrd       , mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,1),(/ni,nj    /)) /= 0. )
+#else
+         CALL iom_set_domain_attr( "grid_"//cdgrd       , mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,1),(/ni*nj    /)) /= 0. )
+#endif  
          CALL iom_set_grid_attr  ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,:),(/ni,nj,jpk/)) /= 0. )
       ENDIF
@@ -1430,4 +1528,6 @@
       ALLOCATE( zlon(ni*nj) )       ;       zlon(:) = 0.
 
+      CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots)
+#if ! defined key_xios2
       CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj)
       CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)
@@ -1435,6 +1535,14 @@
          &                             latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))  
       !
-      CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots)
       CALL iom_set_domain_attr ('ptr', zoom_ibegin=ix, zoom_nj=jpjglo)
+#else
+! Pas teste : attention aux indices !
+      CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj)
+      CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)
+      CALL iom_set_domain_attr("gznl", lonvalue = zlon,   &
+         &                             latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))  
+       CALL iom_set_zoom_domain_attr ("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo)
+#endif
+
       CALL iom_update_file_name('ptr')
       !
@@ -1450,10 +1558,14 @@
       REAL(wp), DIMENSION(1)   ::   zz = 1.
       !!----------------------------------------------------------------------
+#if ! defined key_xios2
       CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea, jbegin=1, ni=1, nj=1)
+#else
+      CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea-1, jbegin=0, ni=1, nj=1)
+#endif
       CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1)
       
       zz=REAL(narea,wp)
       CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz)
-
+      
    END SUBROUTINE set_scalar
 
@@ -1479,12 +1591,24 @@
       REAL(wp)        ,DIMENSION( 3) ::   zlonpira                 ! longitudes of pirata moorings
       REAL(wp)        ,DIMENSION( 9) ::   zlatpira                 ! latitudes  of pirata moorings
+#if  defined key_xios2
+      TYPE(xios_duration)            ::   f_op, f_of
+#endif
+ 
       !!----------------------------------------------------------------------
       ! 
       ! frequency of the call of iom_put (attribut: freq_op)
-      WRITE(cl1,'(i1)')        1   ;   CALL iom_set_field_attr('field_definition', freq_op = cl1//'ts', freq_offset='0ts')
-      WRITE(cl1,'(i1)')  nn_fsbc   ;   CALL iom_set_field_attr('SBC'             , freq_op = cl1//'ts', freq_offset='0ts')
-      WRITE(cl1,'(i1)')  nn_fsbc   ;   CALL iom_set_field_attr('SBC_scalar'      , freq_op = cl1//'ts', freq_offset='0ts')
-      WRITE(cl1,'(i1)') nn_dttrc   ;   CALL iom_set_field_attr('ptrc_T'          , freq_op = cl1//'ts', freq_offset='0ts')
-      WRITE(cl1,'(i1)') nn_dttrc   ;   CALL iom_set_field_attr('diad_T'          , freq_op = cl1//'ts', freq_offset='0ts')
+#if ! defined key_xios2
+      WRITE(cl1,'(i1)')        1   ;   CALL iom_set_field_attr('field_definition', freq_op=cl1//'ts', freq_offset='0ts')
+      WRITE(cl1,'(i1)')  nn_fsbc   ;   CALL iom_set_field_attr('SBC'             , freq_op=cl1//'ts', freq_offset='0ts')
+      WRITE(cl1,'(i1)')  nn_fsbc   ;   CALL iom_set_field_attr('SBC_scalar'      , freq_op=cl1//'ts', freq_offset='0ts')
+      WRITE(cl1,'(i1)') nn_dttrc   ;   CALL iom_set_field_attr('ptrc_T'          , freq_op=cl1//'ts', freq_offset='0ts')
+      WRITE(cl1,'(i1)') nn_dttrc   ;   CALL iom_set_field_attr('diad_T'          , freq_op=cl1//'ts', freq_offset='0ts')
+#else
+      f_op%timestep = 1        ;  f_of%timestep = 0  ; CALL iom_set_field_attr('field_definition', freq_op=f_op, freq_offset=f_of)
+      f_op%timestep = nn_fsbc  ;  f_of%timestep = 0  ; CALL iom_set_field_attr('SBC'             , freq_op=f_op, freq_offset=f_of)
+      f_op%timestep = nn_fsbc  ;  f_of%timestep = 0  ; CALL iom_set_field_attr('SBC_scalar'      , freq_op=f_op, freq_offset=f_of)
+      f_op%timestep = nn_dttrc ;  f_of%timestep = 0  ; CALL iom_set_field_attr('ptrc_T'          , freq_op=f_op, freq_offset=f_of)
+      f_op%timestep = nn_dttrc ;  f_of%timestep = 0  ; CALL iom_set_field_attr('diad_T'          , freq_op=f_op, freq_offset=f_of)
+#endif
        
       ! output file names (attribut: name)
@@ -1508,5 +1632,9 @@
          ! Equatorial section (attributs: jbegin, ni, name_suffix)
          CALL dom_ngb( 0., 0., ix, iy, cl1 )
+#if ! defined key_xios2
          CALL iom_set_domain_attr ('Eq'//cl1, zoom_jbegin=iy, zoom_ni=jpiglo)
+#else
+         CALL iom_set_zoom_domain_attr ('Eq'//cl1, jbegin=iy-1, ni=jpiglo)
+#endif
          CALL iom_get_file_attr   ('Eq'//cl1, name_suffix = clsuff             )
          CALL iom_set_file_attr   ('Eq'//cl1, name_suffix = TRIM(clsuff)//'_Eq')
@@ -1588,5 +1716,9 @@
                ENDIF
                clname = TRIM(ADJUSTL(clat))//TRIM(ADJUSTL(clon))
+#if ! defined key_xios2
                CALL iom_set_domain_attr (TRIM(clname)//cl1, zoom_ibegin= ix, zoom_jbegin= iy)
+#else
+               CALL iom_set_zoom_domain_attr  (TRIM(clname)//cl1, ibegin= ix-1, jbegin= iy-1)
+#endif
                CALL iom_get_file_attr   (TRIM(clname)//cl1, name_suffix = clsuff                         )
                CALL iom_set_file_attr   (TRIM(clname)//cl1, name_suffix = TRIM(clsuff)//'_'//TRIM(clname))
@@ -1617,9 +1749,17 @@
       REAL(wp)           ::   zsec
       LOGICAL            ::   llexist
-      !!----------------------------------------------------------------------
+#if  defined key_xios2
+      TYPE(xios_duration)   ::   output_freq 
+#endif      
+      !!----------------------------------------------------------------------
+
 
       DO jn = 1,2
-
+#if ! defined key_xios2
          IF( jn == 1 )   CALL iom_get_file_attr( cdid, name        = clname, output_freq = clfreq )
+#else
+         output_freq = xios_duration(0,0,0,0,0,0)
+         IF( jn == 1 )   CALL iom_get_file_attr( cdid, name        = clname, output_freq = output_freq )
+#endif
          IF( jn == 2 )   CALL iom_get_file_attr( cdid, name_suffix = clname )
 
@@ -1632,4 +1772,5 @@
             END DO
 
+#if ! defined key_xios2
             idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
             DO WHILE ( idx /= 0 ) 
@@ -1644,5 +1785,30 @@
                idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
             END DO
-
+#else
+            idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
+            DO WHILE ( idx /= 0 ) 
+              IF ( output_freq%timestep /= 0) THEN
+                  WRITE(clfreq,'(I18,A2)')INT(output_freq%timestep),'ts' 
+                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
+              ELSE IF ( output_freq%hour /= 0 ) THEN
+                  WRITE(clfreq,'(I19,A1)')INT(output_freq%hour),'h' 
+                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
+              ELSE IF ( output_freq%day /= 0 ) THEN
+                  WRITE(clfreq,'(I19,A1)')INT(output_freq%day),'d' 
+                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
+              ELSE IF ( output_freq%month /= 0 ) THEN   
+                  WRITE(clfreq,'(I19,A1)')INT(output_freq%month),'m' 
+                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
+              ELSE IF ( output_freq%year /= 0 ) THEN   
+                  WRITE(clfreq,'(I19,A1)')INT(output_freq%year),'y' 
+                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
+              ELSE
+                  CALL ctl_stop('error in the name of file id '//TRIM(cdid),   &
+                     & ' attribute output_freq is undefined -> cannot replace @freq@ in '//TRIM(clname) )
+              ENDIF
+              clname = clname(1:idx-1)//TRIM(ADJUSTL(clfreq))//clname(idx+6:LEN_TRIM(clname))
+              idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
+            END DO
+#endif
             idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@')
             DO WHILE ( idx /= 0 ) 
@@ -1673,4 +1839,5 @@
             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 +1887,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 +1899,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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 6440)
@@ -298,4 +298,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 )
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90	(revision 6440)
@@ -201,45 +201,4 @@
       
 #endif
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) '           defines mpp subdomains'
-         WRITE(numout,*) '           ----------------------'
-         WRITE(numout,*) '           iresti=',iresti,' irestj=',irestj
-         WRITE(numout,*) '           jpni  =',jpni  ,' jpnj  =',jpnj
-         ifreq = 4
-         il1   = 1
-         DO jn = 1, (jpni-1)/ifreq+1
-            il2 = MIN( jpni, il1+ifreq-1 )
-            WRITE(numout,*)
-            WRITE(numout,9200) ('***',ji = il1,il2-1)
-            DO jj = jpnj, 1, -1
-               WRITE(numout,9203) ('   ',ji = il1,il2-1)
-               WRITE(numout,9202) jj, ( ilcit(ji,jj),ilcjt(ji,jj),ji = il1,il2 )
-               WRITE(numout,9203) ('   ',ji = il1,il2-1)
-               WRITE(numout,9200) ('***',ji = il1,il2-1)
-            END DO
-            WRITE(numout,9201) (ji,ji = il1,il2)
-            il1 = il1+ifreq
-         END DO
- 9200    FORMAT('     ***',20('*************',a3))
- 9203    FORMAT('     *     ',20('         *   ',a3))
- 9201    FORMAT('        ',20('   ',i3,'          '))
- 9202    FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
-      ENDIF
-
-      zidom = nreci
-      DO ji = 1, jpni
-         zidom = zidom + ilcit(ji,1) - nreci
-      END DO
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*)' sum ilcit(i,1) = ', zidom, ' jpiglo = ', jpiglo
-      
-      zjdom = nrecj
-      DO jj = 1, jpnj
-         zjdom = zjdom + ilcjt(1,jj) - nrecj
-      END DO
-      IF(lwp) WRITE(numout,*)' sum ilcit(1,j) = ', zjdom, ' jpjglo = ', jpjglo
-      IF(lwp) WRITE(numout,*)
-      
 
       !  2. Index arrays for subdomains
@@ -304,7 +263,54 @@
          nlejt(jn) = nlej
       END DO
-      
-
-      ! 4. From global to local
+
+      ! 4. Subdomain print
+      ! ------------------
+      
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' mpp_init: defines mpp subdomains'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~  ----------------------'
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj
+      zidom = nreci
+      DO ji = 1, jpni
+         zidom = zidom + ilcit(ji,1) - nreci
+      END DO
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*)' sum ilcit(i,1)=', zidom, ' jpiglo=', jpiglo
+
+      zjdom = nrecj
+      DO jj = 1, jpnj
+         zjdom = zjdom + ilcjt(1,jj) - nrecj
+      END DO
+      IF(lwp) WRITE(numout,*)' sum ilcit(1,j)=', zjdom, ' jpjglo=', jpjglo
+      IF(lwp) WRITE(numout,*)
+
+      IF(lwp) THEN
+         ifreq = 4
+         il1   = 1
+         DO jn = 1, (jpni-1)/ifreq+1
+            il2 = MIN( jpni, il1+ifreq-1 )
+            WRITE(numout,*)
+            WRITE(numout,9200) ('***',ji = il1,il2-1)
+            DO jj = jpnj, 1, -1
+               WRITE(numout,9203) ('   ',ji = il1,il2-1)
+               WRITE(numout,9202) jj, ( ilcit(ji,jj),ilcjt(ji,jj),ji = il1,il2 )
+               WRITE(numout,9204) (nfipproc(ji,jj),ji=il1,il2)
+               WRITE(numout,9203) ('   ',ji = il1,il2-1)
+               WRITE(numout,9200) ('***',ji = il1,il2-1)
+            END DO
+            WRITE(numout,9201) (ji,ji = il1,il2)
+            il1 = il1+ifreq
+         END DO
+ 9200     FORMAT('     ***',20('*************',a3))
+ 9203     FORMAT('     *     ',20('         *   ',a3))
+ 9201     FORMAT('        ',20('   ',i3,'          '))
+ 9202     FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
+ 9204     FORMAT('     *  ',20('      ',i3,'   *   '))
+      ENDIF
+
+      ! 5. From global to local
       ! -----------------------
 
@@ -313,5 +319,5 @@
 
 
-      ! 5. Subdomain neighbours
+      ! 6. Subdomain neighbours
       ! ----------------------
 
@@ -436,8 +442,9 @@
          WRITE(numout,*) ' nimpp  = ', nimpp
          WRITE(numout,*) ' njmpp  = ', njmpp
-         WRITE(numout,*) ' nbse   = ', nbse  , ' npse   = ', npse
-         WRITE(numout,*) ' nbsw   = ', nbsw  , ' npsw   = ', npsw
-         WRITE(numout,*) ' nbne   = ', nbne  , ' npne   = ', npne
-         WRITE(numout,*) ' nbnw   = ', nbnw  , ' npnw   = ', npnw
+         WRITE(numout,*) ' nreci  = ', nreci  , ' npse   = ', npse
+         WRITE(numout,*) ' nrecj  = ', nrecj  , ' npsw   = ', npsw
+         WRITE(numout,*) ' jpreci = ', jpreci , ' npne   = ', npne
+         WRITE(numout,*) ' jprecj = ', jprecj , ' npnw   = ', npnw
+         WRITE(numout,*)
       ENDIF
 
@@ -446,7 +453,8 @@
       ! Prepare mpp north fold
 
-      IF (jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
+      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
          CALL mpp_ini_north
-      END IF
+         IF(lwp) WRITE(numout,*) ' mpp_init : North fold boundary prepared for jpni >1'
+      ENDIF
 
       ! Prepare NetCDF output file (if necessary)
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90	(revision 6440)
@@ -318,10 +318,12 @@
          ENDIF
 
+         ! Check wet points over the entire domain to preserve the MPI communication stencil
          isurf = 0
-         DO jj = 1+jprecj, ilj-jprecj
-            DO  ji = 1+jpreci, ili-jpreci
+         DO jj = 1, ilj
+            DO  ji = 1, ili
                IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1
             END DO
          END DO
+
          IF(isurf /= 0) THEN
             icont = icont + 1
@@ -333,5 +335,4 @@
 
       nfipproc(:,:) = ipproc(:,:)
-
 
       ! Control
@@ -441,4 +442,16 @@
       ii = iin(narea)
       ij = ijn(narea)
+
+      ! set default neighbours
+      noso = ioso(ii,ij)
+      nowe = iowe(ii,ij)
+      noea = ioea(ii,ij)
+      nono = iono(ii,ij) 
+      npse = iose(ii,ij)
+      npsw = iosw(ii,ij)
+      npne = ione(ii,ij)
+      npnw = ionw(ii,ij)
+
+      ! check neighbours location
       IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN 
          iiso = 1 + MOD(ioso(ii,ij),jpni)
@@ -511,4 +524,5 @@
       IF (lwp) THEN
          CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
+         WRITE(inum,'(a)') '   jpnij     jpi     jpj     jpk  jpiglo  jpjglo'
          WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
          WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
@@ -523,13 +537,4 @@
       END IF
 
-      IF( nperio == 1 .AND.jpni /= 1 ) CALL ctl_stop( ' mpp_init2:  error on cyclicity' )
-
-      ! Prepare mpp north fold
-
-      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
-         CALL mpp_ini_north
-         IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1'
-      ENDIF
-
       ! Defined npolj, either 0, 3 , 4 , 5 , 6
       ! In this case the important thing is that npolj /= 0
@@ -548,28 +553,37 @@
       ENDIF
 
+      ! Periodicity : no corner if nbondi = 2 and nperio != 1
+
+      IF(lwp) THEN
+         WRITE(numout,*) ' nproc  = ', nproc
+         WRITE(numout,*) ' nowe   = ', nowe  , ' noea   =  ', noea
+         WRITE(numout,*) ' nono   = ', nono  , ' noso   =  ', noso
+         WRITE(numout,*) ' nbondi = ', nbondi
+         WRITE(numout,*) ' nbondj = ', nbondj
+         WRITE(numout,*) ' npolj  = ', npolj
+         WRITE(numout,*) ' nperio = ', nperio
+         WRITE(numout,*) ' nlci   = ', nlci
+         WRITE(numout,*) ' nlcj   = ', nlcj
+         WRITE(numout,*) ' nimpp  = ', nimpp
+         WRITE(numout,*) ' njmpp  = ', njmpp
+         WRITE(numout,*) ' nreci  = ', nreci  , ' npse   = ', npse
+         WRITE(numout,*) ' nrecj  = ', nrecj  , ' npsw   = ', npsw
+         WRITE(numout,*) ' jpreci = ', jpreci , ' npne   = ', npne
+         WRITE(numout,*) ' jprecj = ', jprecj , ' npnw   = ', npnw
+         WRITE(numout,*)
+      ENDIF
+
+      IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( ' mpp_init2: error on cyclicity' )
+
+      ! Prepare mpp north fold
+
+      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
+         CALL mpp_ini_north
+         IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1'
+      ENDIF
+
       ! Prepare NetCDF output file (if necessary)
       CALL mpp_init_ioipsl
 
-      ! Periodicity : no corner if nbondi = 2 and nperio != 1
-
-      IF(lwp) THEN
-         WRITE(numout,*) ' nproc=  ',nproc
-         WRITE(numout,*) ' nowe=   ',nowe
-         WRITE(numout,*) ' noea=   ',noea
-         WRITE(numout,*) ' nono=   ',nono
-         WRITE(numout,*) ' noso=   ',noso
-         WRITE(numout,*) ' nbondi= ',nbondi
-         WRITE(numout,*) ' nbondj= ',nbondj
-         WRITE(numout,*) ' npolj=  ',npolj
-         WRITE(numout,*) ' nperio= ',nperio
-         WRITE(numout,*) ' nlci=   ',nlci
-         WRITE(numout,*) ' nlcj=   ',nlcj
-         WRITE(numout,*) ' nimpp=  ',nimpp
-         WRITE(numout,*) ' njmpp=  ',njmpp
-         WRITE(numout,*) ' nbse=   ',nbse,' npse= ',npse
-         WRITE(numout,*) ' nbsw=   ',nbsw,' npsw= ',npsw
-         WRITE(numout,*) ' nbne=   ',nbne,' npne= ',npne
-         WRITE(numout,*) ' nbnw=   ',nbnw,' npnw= ',npnw
-      ENDIF
 
    END SUBROUTINE mpp_init2
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90	(revision 6440)
@@ -188,10 +188,8 @@
             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)
+               zhmlpu(ji,jj) = ( MAX(hmlpt(ji,jj)  , hmlpt  (ji+1,jj  ), 5._wp)   &
+                  &            - MAX(risfdep(ji,jj), risfdep(ji+1,jj  )       )   )
+               zhmlpv(ji,jj) = ( MAX(hmlpt  (ji,jj), hmlpt  (ji  ,jj+1), 5._wp)   &
+                  &            - MAX(risfdep(ji,jj), risfdep(ji  ,jj+1)       )   )
                ENDDO
             ENDDO
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_oce.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_oce.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_oce.F90	(revision 6440)
@@ -41,4 +41,5 @@
 
    REAL(wp), PUBLIC ::   rldf                        !: multiplicative factor of diffusive coefficient
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   r_fact_lap
                                                      !: Needed to define the ratio between passive and active tracer diffusion coef. 
 
@@ -92,5 +93,5 @@
       !!                 ***  FUNCTION ldftra_oce_alloc  ***
      !!----------------------------------------------------------------------
-     INTEGER, DIMENSION(3) :: ierr
+     INTEGER, DIMENSION(4) :: ierr
      !!----------------------------------------------------------------------
      ierr(:) = 0
@@ -116,4 +117,5 @@
 # endif
 #endif
+      ALLOCATE( r_fact_lap(jpi,jpj,jpk), STAT=ierr(4) )
       ldftra_oce_alloc = MAXVAL( ierr )
       IF( ldftra_oce_alloc /= 0 )   CALL ctl_warn('ldftra_oce_alloc: failed to allocate arrays')
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_substitute.h90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_substitute.h90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_substitute.h90	(revision 6440)
@@ -13,5 +13,5 @@
 !   '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   fsahtu(i,j,k)   rldf * ahtu(i,j,k) * r_fact_lap(i,j,k)
 #       define   fsahtv(i,j,k)   rldf * ahtv(i,j,k)
 #       define   fsahtw(i,j,k)   rldf * ahtw(i,j,k)
@@ -19,5 +19,5 @@
 !   '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   fsahtu(i,j,k)   rldf * ahtu(i,j) * r_fact_lap(i,j,k)
 #       define   fsahtv(i,j,k)   rldf * ahtv(i,j)
 #       define   fsahtw(i,j,k)   rldf * ahtw(i,j)
@@ -25,5 +25,5 @@
 !   'key_traldf_c1d' :                aht: 1D coefficient
 #       define   fsahtt(i,j,k)   rldf * ahtt(k)
-#       define   fsahtu(i,j,k)   rldf * ahtu(k)
+#       define   fsahtu(i,j,k)   rldf * ahtu(k) * r_fact_lap(i,j,k)
 #       define   fsahtv(i,j,k)   rldf * ahtv(k)
 #       define   fsahtw(i,j,k)   rldf * ahtw(k)
@@ -31,5 +31,5 @@
 !   Default option :             aht: Constant coefficient
 #      define   fsahtt(i,j,k)   rldf * aht0
-#      define   fsahtu(i,j,k)   rldf * aht0
+#      define   fsahtu(i,j,k)   rldf * aht0 * r_fact_lap(i,j,k)
 #      define   fsahtv(i,j,k)   rldf * aht0
 #      define   fsahtw(i,j,k)   rldf * aht0
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90	(revision 6440)
@@ -9,4 +9,5 @@
    !!             -   ! 2001-06  (M. Vancoppenolle) LIM 3.0
    !!             -   ! 2006-08  (G. Madec)  cleaning for surface module
+   !!            3.6  ! 2016-01  (C. Rousset) new parameterization for sea ice albedo
    !!----------------------------------------------------------------------
 
@@ -29,21 +30,14 @@
 
    INTEGER  ::   albd_init = 0      !: control flag for initialization
-   REAL(wp) ::   zzero     = 0.e0   ! constant values
-   REAL(wp) ::   zone      = 1.e0   !    "       "
-
-   REAL(wp) ::   c1     = 0.05    ! constants values
-   REAL(wp) ::   c2     = 0.10    !    "        "
-   REAL(wp) ::   rmue   = 0.40    !  cosine of local solar altitude
-
+  
+   REAL(wp) ::   rmue     = 0.40    !  cosine of local solar altitude
+   REAL(wp) ::   ralb_oce = 0.066   ! ocean or lead albedo (Pegau and Paulson, Ann. Glac. 2001)
+   REAL(wp) ::   c1       = 0.05    ! snow thickness (only for nn_ice_alb=0)
+   REAL(wp) ::   c2       = 0.10    !  "        "
+   REAL(wp) ::   rcloud   = 0.06    ! cloud effect on albedo (only-for nn_ice_alb=0)
+ 
    !                             !!* namelist namsbc_alb
-   REAL(wp) ::   rn_cloud         !  cloudiness effect on snow or ice albedo (Grenfell & Perovich, 1984)
-#if defined key_lim3
-   REAL(wp) ::   rn_albice        !  albedo of melting ice in the arctic and antarctic (Shine & Hendersson-Sellers)
-#else
-   REAL(wp) ::   rn_albice        !  albedo of melting ice in the arctic and antarctic (Shine & Hendersson-Sellers)
-#endif
-   REAL(wp) ::   rn_alphd         !  coefficients for linear interpolation used to compute
-   REAL(wp) ::   rn_alphdi        !  albedo between two extremes values (Pyane, 1972)
-   REAL(wp) ::   rn_alphc         ! 
+   INTEGER  ::   nn_ice_alb
+   REAL(wp) ::   rn_albice
 
    !!----------------------------------------------------------------------
@@ -59,11 +53,31 @@
       !!          
       !! ** Purpose :   Computation of the albedo of the snow/ice system 
-      !!                as well as the ocean one
       !!       
-      !! ** Method  : - Computation of the albedo of snow or ice (choose the 
-      !!                rignt one by a large number of tests
-      !!              - Computation of the albedo of the ocean
-      !!
-      !! References :   Shine and Hendersson-Sellers 1985, JGR, 90(D1), 2243-2250.
+      !! ** Method  :   Two schemes are available (from namelist parameter nn_ice_alb)
+      !!                  0: the scheme is that of Shine & Henderson-Sellers (JGR 1985) for clear-skies
+      !!                  1: the scheme is "home made" (for cloudy skies) and based on Brandt et al. (J. Climate 2005)
+      !!                                                                           and Grenfell & Perovich (JGR 2004)
+      !!                Description of scheme 1:
+      !!                  1) Albedo dependency on ice thickness follows the findings from Brandt et al (2005)
+      !!                     which are an update of Allison et al. (JGR 1993) ; Brandt et al. 1999
+      !!                     0-5cm  : linear function of ice thickness
+      !!                     5-150cm: log    function of ice thickness
+      !!                     > 150cm: constant
+      !!                  2) Albedo dependency on snow thickness follows the findings from Grenfell & Perovich (2004)
+      !!                     i.e. it increases as -EXP(-snw_thick/0.02) during freezing and -EXP(-snw_thick/0.03) during melting
+      !!                  3) Albedo dependency on clouds is speculated from measurements of Grenfell and Perovich (2004)
+      !!                     i.e. cloudy-clear albedo depend on cloudy albedo following a 2d order polynomial law
+      !!                  4) The needed 4 parameters are: dry and melting snow, freezing ice and bare puddled ice
+      !!
+      !! ** Note    :   The parameterization from Shine & Henderson-Sellers presents several misconstructions:
+      !!                  1) ice albedo when ice thick. tends to 0 is different than ocean albedo
+      !!                  2) for small ice thick. covered with some snow (<3cm?), albedo is larger 
+      !!                     under melting conditions than under freezing conditions
+      !!                  3) the evolution of ice albedo as a function of ice thickness shows  
+      !!                     3 sharp inflexion points (at 5cm, 100cm and 150cm) that look highly unrealistic
+      !!
+      !! References :   Shine & Henderson-Sellers 1985, JGR, 90(D1), 2243-2250.
+      !!                Brandt et al. 2005, J. Climate, vol 18
+      !!                Grenfell & Perovich 2004, JGR, vol 109 
       !!----------------------------------------------------------------------
       REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pt_ice      !  ice surface temperature (Kelvin)
@@ -73,99 +87,133 @@
       REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pa_ice_os   !  albedo of ice under overcast sky
       !!
-      INTEGER  ::   ji, jj, jl    ! dummy loop indices
-      INTEGER  ::   ijpl          ! number of ice categories (3rd dim of ice input arrays)
-      REAL(wp) ::   zalbpsnm      ! albedo of ice under clear sky when snow is melting
-      REAL(wp) ::   zalbpsnf      ! albedo of ice under clear sky when snow is freezing
-      REAL(wp) ::   zalbpsn       ! albedo of snow/ice system when ice is coverd by snow
-      REAL(wp) ::   zalbpic       ! albedo of snow/ice system when ice is free of snow
-      REAL(wp) ::   zithsn        ! = 1 for hsn >= 0 ( ice is cov. by snow ) ; = 0 otherwise (ice is free of snow)
-      REAL(wp) ::   zitmlsn       ! = 1 freezinz snow (pt_ice >=rt0_snow) ; = 0 melting snow (pt_ice<rt0_snow)
-      REAL(wp) ::   zihsc1        ! = 1 hsn <= c1 ; = 0 hsn > c1
-      REAL(wp) ::   zihsc2        ! = 1 hsn >= c2 ; = 0 hsn < c2
-      !!
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalbfz    ! = rn_alphdi for freezing ice ; = rn_albice for melting ice
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zficeth   !  function of ice thickness
+      INTEGER  ::   ji, jj, jl         ! dummy loop indices
+      INTEGER  ::   ijpl               ! number of ice categories (3rd dim of ice input arrays)
+      REAL(wp)            ::   ralb_im, ralb_sf, ralb_sm, ralb_if
+      REAL(wp)            ::   zswitch, z1_c1, z1_c2
+      REAL(wp)                            ::   zalb_sm, zalb_sf, zalb_st ! albedo of snow melting, freezing, total
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb, zalb_it             ! intermediate variable & albedo of ice (snow free)
       !!---------------------------------------------------------------------
-      
+
       ijpl = SIZE( pt_ice, 3 )                     ! number of ice categories
-
-      CALL wrk_alloc( jpi,jpj,ijpl, zalbfz, zficeth )
+      
+      CALL wrk_alloc( jpi,jpj,ijpl, zalb, zalb_it )
 
       IF( albd_init == 0 )   CALL albedo_init      ! initialization 
 
-      !---------------------------
-      !  Computation of  zficeth
-      !---------------------------
-      ! ice free of snow and melts
-      WHERE     ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice )   ;   zalbfz(:,:,:) = rn_albice
-      ELSE WHERE                                              ;   zalbfz(:,:,:) = rn_alphdi
-      END  WHERE
-
-      WHERE     ( 1.5  < ph_ice                     )  ;  zficeth = zalbfz
-      ELSE WHERE( 1.0  < ph_ice .AND. ph_ice <= 1.5 )  ;  zficeth = 0.472  + 2.0 * ( zalbfz - 0.472 ) * ( ph_ice - 1.0 )
-      ELSE WHERE( 0.05 < ph_ice .AND. ph_ice <= 1.0 )  ;  zficeth = 0.2467 + 0.7049 * ph_ice              &
-         &                                                                 - 0.8608 * ph_ice * ph_ice     &
-         &                                                                 + 0.3812 * ph_ice * ph_ice * ph_ice
-      ELSE WHERE                                       ;  zficeth = 0.1    + 3.6    * ph_ice
-      END WHERE
-
-!!gm old code
-!      DO jl = 1, ijpl
-!         DO jj = 1, jpj
-!            DO ji = 1, jpi
-!               IF( ph_ice(ji,jj,jl) > 1.5 ) THEN
-!                  zficeth(ji,jj,jl) = zalbfz(ji,jj,jl)
-!               ELSEIF( ph_ice(ji,jj,jl) > 1.0  .AND. ph_ice(ji,jj,jl) <= 1.5 ) THEN
-!                  zficeth(ji,jj,jl) = 0.472 + 2.0 * ( zalbfz(ji,jj,jl) - 0.472 ) * ( ph_ice(ji,jj,jl) - 1.0 )
-!               ELSEIF( ph_ice(ji,jj,jl) > 0.05 .AND. ph_ice(ji,jj,jl) <= 1.0 ) THEN
-!                  zficeth(ji,jj,jl) = 0.2467 + 0.7049 * ph_ice(ji,jj,jl)                               &
-!                     &                    - 0.8608 * ph_ice(ji,jj,jl) * ph_ice(ji,jj,jl)                 &
-!                     &                    + 0.3812 * ph_ice(ji,jj,jl) * ph_ice(ji,jj,jl) * ph_ice (ji,jj,jl)
-!               ELSE
-!                  zficeth(ji,jj,jl) = 0.1 + 3.6 * ph_ice(ji,jj,jl) 
-!               ENDIF
-!            END DO
-!         END DO
-!      END DO
-!!gm end old code
-      
-      !----------------------------------------------- 
-      !    Computation of the snow/ice albedo system 
-      !-------------------------- ---------------------
-      
-      !    Albedo of snow-ice for clear sky.
-      !-----------------------------------------------    
-      DO jl = 1, ijpl
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               !  Case of ice covered by snow.             
-               !                                        !  freezing snow        
-               zihsc1   = 1.0 - MAX( zzero , SIGN( zone , - ( ph_snw(ji,jj,jl) - c1 ) ) )
-               zalbpsnf = ( 1.0 - zihsc1 ) * (  zficeth(ji,jj,jl)                                             &
-                  &                           + ph_snw(ji,jj,jl) * ( rn_alphd - zficeth(ji,jj,jl) ) / c1  )   &
-                  &     +         zihsc1   * rn_alphd  
-               !                                        !  melting snow                
-               zihsc2   = MAX( zzero , SIGN( zone , ph_snw(ji,jj,jl) - c2 ) )
-               zalbpsnm = ( 1.0 - zihsc2 ) * ( rn_albice + ph_snw(ji,jj,jl) * ( rn_alphc - rn_albice ) / c2 )   &
-                  &     +         zihsc2   *   rn_alphc 
-               !
-               zitmlsn  =  MAX( zzero , SIGN( zone , pt_ice(ji,jj,jl) - rt0_snow ) )   
-               zalbpsn  =  zitmlsn * zalbpsnm + ( 1.0 - zitmlsn ) * zalbpsnf
-            
-               !  Case of ice free of snow.
-               zalbpic  = zficeth(ji,jj,jl) 
-            
-               ! albedo of the system   
-               zithsn   = 1.0 - MAX( zzero , SIGN( zone , - ph_snw(ji,jj,jl) ) )
-               pa_ice_cs(ji,jj,jl) =  zithsn * zalbpsn + ( 1.0 - zithsn ) *  zalbpic
+      
+      SELECT CASE ( nn_ice_alb )
+
+      !------------------------------------------
+      !  Shine and Henderson-Sellers (1985)
+      !------------------------------------------
+      CASE( 0 )
+       
+         ralb_sf = 0.80       ! dry snow
+         ralb_sm = 0.65       ! melting snow
+         ralb_if = 0.72       ! bare frozen ice
+         ralb_im = rn_albice  ! bare puddled ice 
+         
+         !  Computation of ice albedo (free of snow)
+         WHERE     ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice )   ;   zalb(:,:,:) = ralb_im
+         ELSE WHERE                                              ;   zalb(:,:,:) = ralb_if
+         END  WHERE
+      
+         WHERE     ( 1.5  < ph_ice                     )  ;  zalb_it = zalb
+         ELSE WHERE( 1.0  < ph_ice .AND. ph_ice <= 1.5 )  ;  zalb_it = 0.472  + 2.0 * ( zalb - 0.472 ) * ( ph_ice - 1.0 )
+         ELSE WHERE( 0.05 < ph_ice .AND. ph_ice <= 1.0 )  ;  zalb_it = 0.2467 + 0.7049 * ph_ice              &
+            &                                                                 - 0.8608 * ph_ice * ph_ice     &
+            &                                                                 + 0.3812 * ph_ice * ph_ice * ph_ice
+         ELSE WHERE                                       ;  zalb_it = 0.1    + 3.6    * ph_ice
+         END WHERE
+     
+         DO jl = 1, ijpl
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ! freezing snow
+                  ! no effect of underlying ice layer IF snow thickness > c1. Albedo does not depend on snow thick if > c2
+                  !                                        !  freezing snow        
+                  zswitch   = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ( ph_snw(ji,jj,jl) - c1 ) ) )
+                  zalb_sf   = ( 1._wp - zswitch ) * (  zalb_it(ji,jj,jl)  &
+                     &                           + ph_snw(ji,jj,jl) * ( ralb_sf - zalb_it(ji,jj,jl) ) / c1  )   &
+                     &        +         zswitch   * ralb_sf  
+
+                  ! melting snow
+                  ! no effect of underlying ice layer. Albedo does not depend on snow thick IF > c2
+                  zswitch   = MAX( 0._wp , SIGN( 1._wp , ph_snw(ji,jj,jl) - c2 ) )
+                  zalb_sm = ( 1._wp - zswitch ) * ( ralb_im + ph_snw(ji,jj,jl) * ( ralb_sm - ralb_im ) / c2 )   &
+                      &     +         zswitch   *   ralb_sm 
+                  !
+                  ! snow albedo
+                  zswitch  =  MAX( 0._wp , SIGN( 1._wp , pt_ice(ji,jj,jl) - rt0_snow ) )   
+                  zalb_st  =  zswitch * zalb_sm + ( 1._wp - zswitch ) * zalb_sf
+               
+                  ! Ice/snow albedo
+                  zswitch   = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ph_snw(ji,jj,jl) ) )
+                  pa_ice_cs(ji,jj,jl) =  zswitch * zalb_st + ( 1._wp - zswitch ) * zalb_it(ji,jj,jl)
+                  !
+               END DO
             END DO
          END DO
-      END DO
-      
-      !    Albedo of snow-ice for overcast sky.
-      !----------------------------------------------  
-      pa_ice_os(:,:,:) = pa_ice_cs(:,:,:) + rn_cloud       ! Oberhuber correction
-      !
-      CALL wrk_dealloc( jpi,jpj,ijpl, zalbfz, zficeth )
+
+         pa_ice_os(:,:,:) = pa_ice_cs(:,:,:) + rcloud       ! Oberhuber correction for overcast sky
+
+      !------------------------------------------
+      !  New parameterization (2016)
+      !------------------------------------------
+      CASE( 1 ) 
+
+         ralb_im = rn_albice  ! bare puddled ice
+! compilation of values from literature
+         ralb_sf = 0.85      ! dry snow
+         ralb_sm = 0.75      ! melting snow
+         ralb_if = 0.60      ! bare frozen ice
+! Perovich et al 2002 (Sheba) => the only dataset for which all types of ice/snow were retrieved
+!         ralb_sf = 0.85       ! dry snow
+!         ralb_sm = 0.72       ! melting snow
+!         ralb_if = 0.65       ! bare frozen ice
+! Brandt et al 2005 (East Antarctica)
+!         ralb_sf = 0.87      ! dry snow
+!         ralb_sm = 0.82      ! melting snow
+!         ralb_if = 0.54      ! bare frozen ice
+! 
+         !  Computation of ice albedo (free of snow)
+         z1_c1 = 1. / ( LOG(1.5) - LOG(0.05) ) 
+         z1_c2 = 1. / 0.05
+         WHERE     ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice )   ;   zalb = ralb_im
+         ELSE WHERE                                              ;   zalb = ralb_if
+         END  WHERE
+         
+         WHERE     ( 1.5  < ph_ice                     )  ;  zalb_it = zalb
+         ELSE WHERE( 0.05 < ph_ice .AND. ph_ice <= 1.5 )  ;  zalb_it = zalb     + ( 0.18 - zalb     ) * z1_c1 *  &
+            &                                                                     ( LOG(1.5) - LOG(ph_ice) )
+         ELSE WHERE                                       ;  zalb_it = ralb_oce + ( 0.18 - ralb_oce ) * z1_c2 * ph_ice
+         END WHERE
+
+         z1_c1 = 1. / 0.02
+         z1_c2 = 1. / 0.03
+         !  Computation of the snow/ice albedo
+         DO jl = 1, ijpl
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zalb_sf = ralb_sf - ( ralb_sf - zalb_it(ji,jj,jl)) * EXP( - ph_snw(ji,jj,jl) * z1_c1 );
+                  zalb_sm = ralb_sm - ( ralb_sm - zalb_it(ji,jj,jl)) * EXP( - ph_snw(ji,jj,jl) * z1_c2 );
+
+                   ! snow albedo
+                  zswitch = MAX( 0._wp , SIGN( 1._wp , pt_ice(ji,jj,jl) - rt0_snow ) )   
+                  zalb_st = zswitch * zalb_sm + ( 1._wp - zswitch ) * zalb_sf
+
+                  ! Ice/snow albedo   
+                  zswitch             = MAX( 0._wp , SIGN( 1._wp , - ph_snw(ji,jj,jl) ) )
+                  pa_ice_os(ji,jj,jl) = ( 1._wp - zswitch ) * zalb_st + zswitch *  zalb_it(ji,jj,jl)
+
+              END DO
+            END DO
+         END DO
+         ! Effect of the clouds (2d order polynomial)
+         pa_ice_cs = pa_ice_os - ( - 0.1010 * pa_ice_os * pa_ice_os + 0.1933 * pa_ice_os - 0.0148 ); 
+
+      END SELECT
+      
+      CALL wrk_dealloc( jpi,jpj,ijpl, zalb, zalb_it )
       !
    END SUBROUTINE albedo_ice
@@ -181,10 +229,10 @@
       REAL(wp), DIMENSION(:,:), INTENT(out) ::   pa_oce_cs   !  albedo of ocean under clear sky
       !!
-      REAL(wp) ::   zcoef   ! local scalar
-      !!----------------------------------------------------------------------
-      !
-      zcoef = 0.05 / ( 1.1 * rmue**1.4 + 0.15 )      ! Parameterization of Briegled and Ramanathan, 1982 
-      pa_oce_cs(:,:) = zcoef               
-      pa_oce_os(:,:)  = 0.06                         ! Parameterization of Kondratyev, 1969 and Payne, 1972
+      REAL(wp) :: zcoef 
+      !!----------------------------------------------------------------------
+      !
+      zcoef = 0.05 / ( 1.1 * rmue**1.4 + 0.15 )   ! Parameterization of Briegled and Ramanathan, 1982
+      pa_oce_cs(:,:) = zcoef 
+      pa_oce_os(:,:) = 0.06                       ! Parameterization of Kondratyev, 1969 and Payne, 1972
       !
    END SUBROUTINE albedo_oce
@@ -200,5 +248,5 @@
       !!----------------------------------------------------------------------
       INTEGER  ::   ios                 ! Local integer output status for namelist read
-      NAMELIST/namsbc_alb/ rn_cloud, rn_albice, rn_alphd, rn_alphdi, rn_alphc
+      NAMELIST/namsbc_alb/ nn_ice_alb, rn_albice 
       !!----------------------------------------------------------------------
       !
@@ -219,9 +267,6 @@
          WRITE(numout,*) '~~~~~~~'
          WRITE(numout,*) '   Namelist namsbc_alb : albedo '
-         WRITE(numout,*) '      correction for snow and ice albedo                  rn_cloud  = ', rn_cloud
-         WRITE(numout,*) '      albedo of melting ice in the arctic and antarctic   rn_albice = ', rn_albice
-         WRITE(numout,*) '      coefficients for linear                             rn_alphd  = ', rn_alphd
-         WRITE(numout,*) '      interpolation used to compute albedo                rn_alphdi = ', rn_alphdi
-         WRITE(numout,*) '      between two extremes values (Pyane, 1972)           rn_alphc  = ', rn_alphc
+         WRITE(numout,*) '      choose the albedo parameterization                  nn_ice_alb = ', nn_ice_alb
+         WRITE(numout,*) '      albedo of bare puddled ice                          rn_albice  = ', rn_albice
       ENDIF
       !
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90	(revision 6440)
@@ -32,4 +32,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
@@ -815,4 +816,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
@@ -1281,5 +1290,5 @@
       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
+      REAL(wp),DIMENSION(:,:,:),ALLOCATABLE     ::   ztmp_fly_dta                          ! 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
@@ -1347,6 +1356,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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90	(revision 6440)
@@ -80,5 +80,6 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qemp_oce       !: heat flux of precip and evap over ocean     [W/m2]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qemp_ice       !: heat flux of precip and evap over ice       [W/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qprec_ice      !: heat flux of precip over ice                [J/m3]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qevap_ice      !: heat flux of evap over ice                  [W/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qprec_ice      !: enthalpy of precip over ice                 [J/m3]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_oce        !: evap - precip over ocean                 [kg/m2/s]
 #endif
@@ -144,7 +145,7 @@
 #endif
 #if defined key_lim3
-         &      evap_ice(jpi,jpj,jpl) , devap_ice(jpi,jpj,jpl) , qprec_ice(jpi,jpj) ,  &
-         &      qemp_ice(jpi,jpj)     , qemp_oce(jpi,jpj)      ,                       &
-         &      qns_oce (jpi,jpj)     , qsr_oce (jpi,jpj)      , emp_oce (jpi,jpj)  ,  &
+         &      evap_ice(jpi,jpj,jpl) , devap_ice(jpi,jpj,jpl) , qprec_ice(jpi,jpj) ,   &
+         &      qemp_ice(jpi,jpj)     , qevap_ice(jpi,jpj,jpl) , qemp_oce (jpi,jpj) ,   &
+         &      qns_oce (jpi,jpj)     , qsr_oce  (jpi,jpj)     , emp_oce (jpi,jpj)  ,   &
 #endif
          &      emp_ice(jpi,jpj)      ,  STAT= ierr(1) )
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90	(revision 6440)
@@ -684,4 +684,10 @@
       qprec_ice(:,:) = rhosn * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus )
 
+      ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- !
+      DO jl = 1, jpl
+         qevap_ice(:,:,jl) = 0._wp ! should be -evap_ice(:,:,jl)*( ( Tice - rt0 ) * cpic * tmask(:,:,1) - lfus )
+                                   ! but then qemp_ice should also include sublimation 
+      END DO
+
       CALL wrk_dealloc( jpi,jpj, zevap, zsnw ) 
 #endif
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90	(revision 6440)
@@ -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
       !
@@ -608,7 +612,7 @@
       ! --- evaporation --- !
       z1_lsub = 1._wp / Lsub
-      evap_ice (:,:,:) = qla_ice (:,:,:) * z1_lsub ! sublimation
-      devap_ice(:,:,:) = dqla_ice(:,:,:) * z1_lsub
-      zevap    (:,:)   = emp(:,:) + tprecip(:,:)   ! evaporation over ocean
+      evap_ice (:,:,:) = rn_efac * qla_ice (:,:,:) * z1_lsub    ! sublimation
+      devap_ice(:,:,:) = rn_efac * dqla_ice(:,:,:) * z1_lsub    ! d(sublimation)/dT
+      zevap    (:,:)   = rn_efac * ( emp(:,:) + tprecip(:,:) )  ! evaporation over ocean
 
       ! --- evaporation minus precipitation --- !
@@ -633,4 +637,10 @@
       ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- !
       qprec_ice(:,:) = rhosn * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus )
+
+      ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- !
+      DO jl = 1, jpl
+         qevap_ice(:,:,jl) = 0._wp ! should be -evap_ice(:,:,jl)*( ( Tice - rt0 ) * cpic * tmask(:,:,1) )
+                                   ! But we do not have Tice => consider it at 0°C => evap=0 
+      END DO
 
       CALL wrk_dealloc( jpi,jpj, zevap, zsnw ) 
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90	(revision 6440)
@@ -1029,4 +1029,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 +1035,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
@@ -1376,14 +1378,16 @@
       !
       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
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zqns_ice, zqsr_ice, zdqns_ice
-      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zevap, zsnw, zqns_oce, zqsr_oce, zqprec_ice, zqemp_oce ! for LIM3
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zcptn, ztmp, zicefr, zmsk, zsnw
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap, zevap_ice, zdevap_ice
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zqns_ice, zqsr_ice, zdqns_ice, zqevap_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 )
+      CALL wrk_alloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zsnw )
+      CALL wrk_alloc( jpi,jpj,     zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap, zevap_ice, zdevap_ice )
+      CALL wrk_alloc( jpi,jpj,     zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice )
+      CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice )
 
       IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0)
@@ -1421,8 +1425,57 @@
       END SELECT
 
-      IF( iom_use('subl_ai_cea') )   &
-         CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )   ! Sublimation over sea-ice         (cell average)
-      !   
-      !                                                           ! runoffs and calving (put in emp_tot)
+#if defined key_lim3
+      ! zsnw = snow percentage over ice after wind blowing
+      zsnw(:,:) = 0._wp
+      CALL lim_thd_snwblow( p_frld, zsnw )
+      
+      ! --- evaporation (kg/m2/s) --- !
+      zevap_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1)
+      ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0
+      ! therefore, sublimation is not redistributed over the ice categories in case no subgrid scale fluxes are provided by atm.
+      zdevap_ice(:,:) = 0._wp
+      
+      ! --- evaporation minus precipitation corrected for the effect of wind blowing on snow --- !
+      zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:) - zsprecip * (1._wp - zsnw)
+      zemp_ice(:,:) = zemp_ice(:,:) + zsprecip * (1._wp - zsnw)          
+
+      ! Sublimation over sea-ice (cell average)
+      IF( iom_use('subl_ai_cea') )  CALL iom_put( 'subl_ai_cea', zevap_ice(:,:) * zicefr(:,:) )
+      ! runoffs and calving (put in emp_tot)
+      IF( srcv(jpr_rnf)%laction )   rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
+      IF( srcv(jpr_cal)%laction ) THEN 
+         zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)
+         CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) )
+      ENDIF
+
+      IF( ln_mixcpl ) THEN
+         emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:)
+         emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:)
+         emp_oce(:,:) = emp_oce(:,:) * xcplmask(:,:,0) + zemp_oce(:,:) * zmsk(:,:)
+         sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:)
+         tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:)
+         DO jl=1,jpl
+            evap_ice (:,:,jl) = evap_ice (:,:,jl) * xcplmask(:,:,0) + zevap_ice (:,:) * zmsk(:,:)
+            devap_ice(:,:,jl) = devap_ice(:,:,jl) * xcplmask(:,:,0) + zdevap_ice(:,:) * zmsk(:,:)
+         ENDDO
+      ELSE
+         emp_tot(:,:) =         zemp_tot(:,:)
+         emp_ice(:,:) =         zemp_ice(:,:)
+         emp_oce(:,:) =         zemp_oce(:,:)     
+         sprecip(:,:) =         zsprecip(:,:)
+         tprecip(:,:) =         ztprecip(:,:)
+         DO jl=1,jpl
+            evap_ice (:,:,jl) = zevap_ice (:,:)
+            devap_ice(:,:,jl) = zdevap_ice(:,:)
+         ENDDO
+      ENDIF
+
+                                     CALL iom_put( 'snowpre'    , sprecip                         )  ! Snow
+      IF( iom_use('snow_ao_cea') )   CALL iom_put( 'snow_ao_cea', sprecip(:,:) * ( 1._wp - zsnw ) )  ! Snow over ice-free ocean  (cell average)
+      IF( iom_use('snow_ai_cea') )   CALL iom_put( 'snow_ai_cea', sprecip(:,:) *           zsnw   )  ! Snow over sea-ice         (cell average)    
+#else
+      ! Sublimation over sea-ice (cell average)
+      IF( iom_use('subl_ai_cea') )  CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )
+      ! runoffs and calving (put in emp_tot)
       IF( srcv(jpr_rnf)%laction )   rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
       IF( srcv(jpr_cal)%laction ) THEN 
@@ -1448,4 +1501,5 @@
       IF( iom_use('snow_ai_cea') )   &
          CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:)             )   ! Snow        over sea-ice         (cell average)
+#endif
 
       !                                                      ! ========================= !
@@ -1503,18 +1557,7 @@
       IF( iom_use('hflx_snow_cea') )    CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average)
 
-#if defined key_lim3
-      CALL wrk_alloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ) 
-
+#if defined key_lim3      
       ! --- evaporation --- !
-      ! clem: evap_ice is set to 0 for LIM3 since we still do not know what to do with sublimation
-      ! the problem is: the atm. imposes both mass evaporation and heat removed from the snow/ice
-      !                 but it is incoherent WITH the ice model  
-      DO jl=1,jpl
-         evap_ice(:,:,jl) = 0._wp  ! should be: frcv(jpr_ievp)%z3(:,:,1)
-      ENDDO
       zevap(:,:) = zemp_tot(:,:) + ztprecip(:,:) ! evaporation over ocean
-
-      ! --- evaporation minus precipitation --- !
-      emp_oce(:,:) = emp_tot(:,:) - emp_ice(:,:)
 
       ! --- non solar flux over ocean --- !
@@ -1523,18 +1566,23 @@
       WHERE( p_frld /= 0._wp )  zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:)
 
-      ! --- heat flux associated with emp --- !
-      zsnw(:,:) = 0._wp
-      CALL lim_thd_snwblow( p_frld, zsnw )  ! snow distribution over ice after wind blowing
+      ! --- heat flux associated with emp (W/m2) --- !
       zqemp_oce(:,:) = -      zevap(:,:)                   * p_frld(:,:)      *   zcptn(:,:)   &      ! evap
          &             + ( ztprecip(:,:) - zsprecip(:,:) )                    *   zcptn(:,:)   &      ! liquid precip
          &             +   zsprecip(:,:)                   * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean
-      qemp_ice(:,:)  = -   frcv(jpr_ievp)%z3(:,:,1)        * zicefr(:,:)      *   zcptn(:,:)   &      ! ice evap
-         &             +   zsprecip(:,:)                   * zsnw             * ( zcptn(:,:) - lfus ) ! solid precip over ice
-
+!      zqemp_ice(:,:) = -   frcv(jpr_ievp)%z3(:,:,1)        * zicefr(:,:)      *   zcptn(:,:)   &      ! ice evap
+!         &             +   zsprecip(:,:)                   * zsnw             * ( zcptn(:,:) - lfus ) ! solid precip over ice
+      zqemp_ice(:,:) =      zsprecip(:,:)                   * zsnw             * ( zcptn(:,:) - lfus ) ! solid precip over ice (only)
+                                                                                                       ! qevap_ice=0 since we consider Tice=0°C
+      
       ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- !
       zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus )
 
-      ! --- total non solar flux --- !
-      zqns_tot(:,:) = zqns_tot(:,:) + qemp_ice(:,:) + zqemp_oce(:,:)
+      ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- !
+      DO jl = 1, jpl
+         zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * cpic ) but we do not have Tice, so we consider Tice=0°C
+      END DO
+
+      ! --- total non solar flux (including evap/precip) --- !
+      zqns_tot(:,:) = zqns_tot(:,:) + zqemp_ice(:,:) + zqemp_oce(:,:)
 
       ! --- in case both coupled/forced are active, we must mix values --- ! 
@@ -1543,20 +1591,20 @@
          qns_oce(:,:) = qns_oce(:,:) * xcplmask(:,:,0) + zqns_oce(:,:)* zmsk(:,:)
          DO jl=1,jpl
-            qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) +  zqns_ice(:,:,jl)* zmsk(:,:)
+            qns_ice  (:,:,jl) = qns_ice  (:,:,jl) * xcplmask(:,:,0) +  zqns_ice  (:,:,jl)* zmsk(:,:)
+            qevap_ice(:,:,jl) = qevap_ice(:,:,jl) * xcplmask(:,:,0) +  zqevap_ice(:,:,jl)* zmsk(:,:)
          ENDDO
          qprec_ice(:,:) = qprec_ice(:,:) * xcplmask(:,:,0) + zqprec_ice(:,:)* zmsk(:,:)
          qemp_oce (:,:) =  qemp_oce(:,:) * xcplmask(:,:,0) +  zqemp_oce(:,:)* zmsk(:,:)
-!!clem         evap_ice(:,:) = evap_ice(:,:) * xcplmask(:,:,0)
+         qemp_ice (:,:) =  qemp_ice(:,:) * xcplmask(:,:,0) +  zqemp_ice(:,:)* zmsk(:,:)
       ELSE
          qns_tot  (:,:  ) = zqns_tot  (:,:  )
          qns_oce  (:,:  ) = zqns_oce  (:,:  )
          qns_ice  (:,:,:) = zqns_ice  (:,:,:)
-         qprec_ice(:,:)   = zqprec_ice(:,:)
-         qemp_oce (:,:)   = zqemp_oce (:,:)
-      ENDIF
-
-      CALL wrk_dealloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ) 
+         qevap_ice(:,:,:) = zqevap_ice(:,:,:)
+         qprec_ice(:,:  ) = zqprec_ice(:,:  )
+         qemp_oce (:,:  ) = zqemp_oce (:,:  )
+         qemp_ice (:,:  ) = zqemp_ice (:,:  )
+      ENDIF
 #else
-
       ! clem: this formulation is certainly wrong... but better than it was...
       zqns_tot(:,:) = zqns_tot(:,:)                       &            ! zqns_tot update over free ocean with:
@@ -1575,5 +1623,4 @@
          qns_ice(:,:,:) = zqns_ice(:,:,:)
       ENDIF
-
 #endif
 
@@ -1626,5 +1673,4 @@
 
 #if defined key_lim3
-      CALL wrk_alloc( jpi,jpj, zqsr_oce ) 
       ! --- solar flux over ocean --- !
       !         note: p_frld cannot be = 0 since we limit the ice concentration to amax
@@ -1634,6 +1680,4 @@
       IF( ln_mixcpl ) THEN   ;   qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) +  zqsr_oce(:,:)* zmsk(:,:)
       ELSE                   ;   qsr_oce(:,:) = zqsr_oce(:,:)   ;   ENDIF
-
-      CALL wrk_dealloc( jpi,jpj, zqsr_oce ) 
 #endif
 
@@ -1686,6 +1730,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 )
+      CALL wrk_dealloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zsnw )
+      CALL wrk_dealloc( jpi,jpj,     zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap, zevap_ice, zdevap_ice )
+      CALL wrk_dealloc( jpi,jpj,     zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice )
+      CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice )
       !
       IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_ice_flx')
@@ -1743,5 +1789,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 +1820,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(:,:)
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90	(revision 6440)
@@ -108,5 +108,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)
@@ -162,5 +162,5 @@
             zsurf_pos = glob_sum( e1e2t(:,:)*ztmsk_pos(:,:) )
             !                                                  ! fwf global mean (excluding ocean to ice/snow exchanges) 
-            z_fwf     = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + 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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90	(revision 6440)
@@ -103,5 +103,6 @@
                                  ! ( d rho / dt ) / ( d rho / ds )      ( s = 34, t = -1.8 )
          
-         fr_i(:,:) = eos_fzp( sss_m ) * tmask(:,:,1)      ! sea surface freezing temperature [Celcius]
+         CALL eos_fzp( sss_m(:,:), fr_i(:,:) )       ! sea surface freezing temperature [Celcius]
+         fr_i(:,:) = fr_i(:,:) * tmask(:,:,1)
 
          IF( ln_cpl )   a_i(:,:,1) = fr_i(:,:)         
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90	(revision 6440)
@@ -110,5 +110,4 @@
       INTEGER  ::   jl                 ! dummy loop index
       REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_os, zalb_cs  ! ice albedo under overcast/clear sky
-      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_ice          ! mean ice albedo (for coupled)
       REAL(wp), POINTER, DIMENSION(:,:  )   ::   zutau_ice, zvtau_ice 
       !!----------------------------------------------------------------------
@@ -126,6 +125,7 @@
          
          ! masked sea surface freezing temperature [Kelvin] (set to rt0 over land)
-         t_bo(:,:) = ( eos_fzp( sss_m ) + rt0 ) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) )  
-         
+         CALL eos_fzp( sss_m(:,:) , t_bo(:,:) )
+         t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) )
+          
          ! Mask sea ice surface temperature (set to rt0 over land)
          DO jl = 1, jpl
@@ -196,5 +196,5 @@
          ! fr1_i0  , fr2_i0   : 1sr & 2nd fraction of qsr penetration in ice             [%]
          !----------------------------------------------------------------------------------------
-         CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice )
+         CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs )
          CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos
 
@@ -202,24 +202,21 @@
          CASE( jp_clio )                                       ! CLIO bulk formulation
             ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo 
-            ! (zalb_ice) is computed within the bulk routine
-            CALL blk_ice_clio_flx( t_su, zalb_cs, zalb_os, zalb_ice )
-            IF( ln_mixcpl      ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su )
-            IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx )
+            ! (alb_ice) is computed within the bulk routine
+                                 CALL blk_ice_clio_flx( t_su, zalb_cs, zalb_os, alb_ice )
+            IF( ln_mixcpl      ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su )
+            IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx )
          CASE( jp_core )                                       ! CORE bulk formulation
             ! albedo depends on cloud fraction because of non-linear spectral effects
-            zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
-            CALL blk_ice_core_flx( t_su, zalb_ice )
-            IF( ln_mixcpl      ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su )
-            IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx )
+            alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
+                                 CALL blk_ice_core_flx( t_su, alb_ice )
+            IF( ln_mixcpl      ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su )
+            IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx )
          CASE ( jp_purecpl )
             ! albedo depends on cloud fraction because of non-linear spectral effects
-            zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
-                                 CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su )
-            ! clem: evap_ice is forced to 0 in coupled mode for now 
-            !       but it needs to be changed (along with modif in limthd_dh) once heat flux from evap will be avail. from atm. models
-            evap_ice  (:,:,:) = 0._wp   ;   devap_ice (:,:,:) = 0._wp
-            IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx )
+            alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
+                                 CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su )
+            IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx )
          END SELECT
-         CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice )
+         CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs )
 
          !----------------------------!
@@ -264,4 +261,5 @@
       !!----------------------------------------------------------------------
       INTEGER :: ierr
+      INTEGER :: ji, jj
       !!----------------------------------------------------------------------
       IF(lwp) WRITE(numout,*)
@@ -320,4 +318,12 @@
       tn_ice(:,:,:) = t_su(:,:,:)       ! initialisation of surface temp for coupled simu
       !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( gphit(ji,jj) > 0._wp ) THEN  ;  rn_amax_2d(ji,jj) = rn_amax_n  ! NH
+            ELSE                             ;  rn_amax_2d(ji,jj) = rn_amax_s  ! SH
+            ENDIF
+        ENDDO
+      ENDDO 
+      !
       nstart = numit  + nn_fsbc      
       nitrun = nitend - nit000 + 1 
@@ -342,5 +348,5 @@
       INTEGER  ::   ios                 ! Local integer output status for namelist read
       NAMELIST/namicerun/ jpl, nlay_i, nlay_s, cn_icerst_in, cn_icerst_indir, cn_icerst_out, cn_icerst_outdir,  &
-         &                ln_limdyn, rn_amax, ln_limdiahsb, ln_limdiaout, ln_icectl, iiceprt, jiceprt  
+         &                ln_limdyn, rn_amax_n, rn_amax_s, ln_limdiahsb, ln_limdiaout, ln_icectl, iiceprt, jiceprt  
       !!-------------------------------------------------------------------
       !                    
@@ -363,5 +369,6 @@
          WRITE(numout,*) '   number of snow layers                                   = ', nlay_s
          WRITE(numout,*) '   switch for ice dynamics (1) or not (0)      ln_limdyn   = ', ln_limdyn
-         WRITE(numout,*) '   maximum ice concentration                               = ', rn_amax 
+         WRITE(numout,*) '   maximum ice concentration for NH                        = ', rn_amax_n 
+         WRITE(numout,*) '   maximum ice concentration for SH                        = ', rn_amax_s
          WRITE(numout,*) '   Diagnose heat/salt budget or not          ln_limdiahsb  = ', ln_limdiahsb
          WRITE(numout,*) '   Output   heat/salt budget or not          ln_limdiaout  = ', ln_limdiaout
@@ -578,5 +585,5 @@
       sfx_bog(:,:) = 0._wp   ;   sfx_dyn(:,:) = 0._wp
       sfx_bom(:,:) = 0._wp   ;   sfx_sum(:,:) = 0._wp
-      sfx_res(:,:) = 0._wp
+      sfx_res(:,:) = 0._wp   ;   sfx_sub(:,:) = 0._wp
       
       wfx_snw(:,:) = 0._wp   ;   wfx_ice(:,:) = 0._wp
@@ -594,6 +601,7 @@
       hfx_spr(:,:) = 0._wp   ;   hfx_dif(:,:) = 0._wp 
       hfx_err(:,:) = 0._wp   ;   hfx_err_rem(:,:) = 0._wp
-      hfx_err_dif(:,:) = 0._wp   ;
-
+      hfx_err_dif(:,:) = 0._wp
+      wfx_err_sub(:,:) = 0._wp
+      
       afx_tot(:,:) = 0._wp   ;
       afx_dyn(:,:) = 0._wp   ;   afx_thd(:,:) = 0._wp
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90	(revision 6440)
@@ -150,5 +150,6 @@
 
          ! ... masked sea surface freezing temperature [Kelvin] (set to rt0 over land)
-         tfu(:,:) = eos_fzp( sss_m ) +  rt0 
+         CALL eos_fzp( sss_m(:,:), tfu(:,:) )
+         tfu(:,:) = tfu(:,:) + rt0
 
          zsist (:,:,1) = sist (:,:) + rt0 * ( 1. - tmask(:,:,1) )
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90	(revision 6440)
@@ -53,11 +53,5 @@
    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
 
 
@@ -92,5 +86,6 @@
     REAL(wp)                     ::   rmin
     REAL(wp)                     ::   zhk
-    CHARACTER(len=256)           ::   cfisf, cvarzisf, cvarhisf   ! name for isf file
+    REAL(wp)                     ::   zt_frz, zpress
+    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
@@ -176,5 +171,5 @@
               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
+                  DO WHILE ( jk .LE. mbkt(ji,jj) .AND. gdepw_0(ji,jj,jk) < rzisf_tbl(ji,jj) ) ;  jk = jk + 1 ;  END DO
                   misfkt(ji,jj) = jk-1
                END DO
@@ -194,5 +189,18 @@
          END IF
          
+         ! save initial top boundary layer thickness         
          rhisf_tbl_0(:,:) = rhisf_tbl(:,:)
+
+      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 bottom level of isf tbl and thickness of tbl below the ice shelf
@@ -205,5 +213,4 @@
 
                ! 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
@@ -217,17 +224,4 @@
             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
@@ -270,10 +264,19 @@
          END IF
          ! 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 !
+         ! WARNING water add at temp = 0C, correction term is added, maybe better here but need a 3D variable).
+!         zpress = grav*rau0*fsdept(ji,jj,jk)*1.e-04
+         zt_frz = -1.9 !eos_fzp( tsn(ji,jj,jk,jp_sal), zpress )
+         risf_tsc(:,:,jp_tem) = qisf(:,:) * r1_rau0_rcp - rdivisf * fwfisf(:,:) * zt_frz * r1_rau0 !
          
          ! salt effect already take into account in vertical advection
          risf_tsc(:,:,jp_sal) = (1.0_wp-rdivisf) * fwfisf(:,:) * stbl(:,:) * r1_rau0
-          
+
+         ! output
+         IF( iom_use('qisf'  ) )   CALL iom_put('qisf'  , qisf)
+         IF( iom_use('fwfisf') )   CALL iom_put('fwfisf', fwfisf * stbl(:,:) / soce )
+
+         ! if apply only on the trend and not as a volume flux (rdivisf = 0), fwfisf have to be set to 0 now
+         fwfisf(:,:) = rdivisf * fwfisf(:,:)         
+ 
          ! lbclnk
          CALL lbc_lnk(risf_tsc(:,:,jp_tem),'T',1.)
@@ -295,7 +298,4 @@
          ENDIF
          ! 
-         ! output
-         CALL iom_put('qisf'  , qisf)
-         IF( iom_use('fwfisf') )   CALL iom_put('fwfisf', fwfisf * stbl(:,:) / soce )
       END IF
   
@@ -370,5 +370,5 @@
              ! Calculate freezing temperature
                 zpress = grav*rau0*fsdept(ji,jj,ik)*1.e-04 
-                zt_frz = eos_fzp(tsb(ji,jj,ik,jp_sal), zpress) 
+                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
@@ -452,5 +452,5 @@
       zti(:,:)=tinsitu( ttbl, stbl, zpress )
 ! Calculate freezing temperature
-      zfrz(:,:)=eos_fzp( sss_m(:,:), zpress )
+      CALL eos_fzp( sss_m(:,:), zfrz(:,:), zpress )
 
       
@@ -472,9 +472,6 @@
 
                      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
+                     IF (nit .GE. 100) CALL ctl_stop( 'STOP', 'sbc_isf_hol99 : too many iteration ...' )
+
 ! save gammat and compute zhtflx_b
                      zgammat2d(ji,jj)=zgammat
@@ -794,5 +791,5 @@
                ! test on tmask useless ?????
                DO jk = ikt, mbkt(ji,jj)
-!                  IF ( (SUM(fse3t(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk
+                  IF ( (SUM(fse3t(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk
                END DO
                rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(fse3t(ji,jj,ikt:ikb)))  ! limit the tbl to water thickness.
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90	(revision 6440)
@@ -179,8 +179,9 @@
 
       !                          ! Checks:
-      IF( nn_isf .EQ. 0 ) THEN                      ! no specific treatment in vicinity of ice shelf 
+      IF( nn_isf .EQ. 0 ) 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
+         rdivisf       = 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
@@ -455,5 +456,6 @@
       !                                                ! ---------------------------------------- !
       IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN
-         CALL iom_put( "empmr" , emp  - rnf )                   ! upward water flux
+         CALL iom_put( "empmr"  , emp    - rnf )                ! upward water flux
+         CALL iom_put( "empbmr" , emp_b  - rnf )                ! before upward water flux ( needed to recalculate the time evolution of ssh in offline )
          CALL iom_put( "saltflx", sfx  )                        ! downward salt flux  
                                                                 ! (includes virtual salt flux beneath ice 
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90	(revision 6440)
@@ -52,5 +52,5 @@
    REAL(wp)                   ::   rn_hrnf         !: runoffs, depth over which enhanced vertical mixing is used
    REAL(wp)          , PUBLIC ::   rn_avt_rnf      !: runoffs, value of the additional vertical mixing coef. [m2/s]
-   REAL(wp)                   ::   rn_rfact        !: multiplicative factor for runoff
+   REAL(wp)          , PUBLIC ::   rn_rfact        !: multiplicative factor for runoff
 
    LOGICAL           , PUBLIC ::   l_rnfcpl = .false.       ! runoffs recieved from oasis
@@ -125,12 +125,4 @@
       IF(   ln_rnf_tem   )   CALL fld_read ( kt, nn_fsbc, sf_t_rnf )    ! idem for runoffs temperature if required
       IF(   ln_rnf_sal   )   CALL fld_read ( kt, nn_fsbc, sf_s_rnf )    ! idem for runoffs salinity    if required
-      !
-      ! Runoff reduction only associated to the ORCA2_LIM configuration
-      ! when reading the NetCDF file runoff_1m_nomask.nc
-      IF( cp_cfg == 'orca' .AND. jp_cfg == 2 .AND. .NOT. l_rnfcpl )   THEN
-         WHERE( 40._wp < gphit(:,:) .AND. gphit(:,:) < 65._wp )
-            sf_rnf(1)%fnow(:,:,1) = 0.85 * sf_rnf(1)%fnow(:,:,1)
-         END WHERE
-      ENDIF
       !
       IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SOL/solver.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SOL/solver.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/SOL/solver.F90	(revision 6440)
@@ -92,4 +92,6 @@
       IF( .NOT. lk_agrif .OR. .NOT. ln_rstart) THEN
          IF( sol_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'solver_init : unable to allocate sol_oce arrays' )
+         gcx (:,:) = 0.e0
+         gcxb(:,:) = 0.e0
       ENDIF
 
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/STO/stopar.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/STO/stopar.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/STO/stopar.F90	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90	(revision 6440)
@@ -22,4 +22,5 @@
    !!             -   ! 2013-04  (F. Roquet, G. Madec)  add eos_rab, change bn2 computation and reorganize the module
    !!             -   ! 2014-09  (F. Roquet)  add TEOS-10, S-EOS, and modify EOS-80
+   !!             -   ! 2015-06  (P.A. Bouttier) eos_fzp functions changed to subroutines for AGRIF
    !!----------------------------------------------------------------------
 
@@ -991,5 +992,5 @@
 
 
-   FUNCTION eos_fzp_2d( psal, pdep ) RESULT( ptf )
+   SUBROUTINE  eos_fzp_2d( psal, ptf, pdep )
       !!----------------------------------------------------------------------
       !!                 ***  ROUTINE eos_fzp  ***
@@ -1005,5 +1006,5 @@
       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   )           ::   psal   ! salinity   [psu]
       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ), OPTIONAL ::   pdep   ! depth      [m]
-      REAL(wp), DIMENSION(jpi,jpj)                          ::   ptf   ! freezing temperature [Celcius]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(out  )           ::   ptf    ! freezing temperature [Celcius]
       !
       INTEGER  ::   ji, jj   ! dummy loop indices
@@ -1038,9 +1039,9 @@
          nstop = nstop + 1
          !
-      END SELECT
-      !
-   END FUNCTION eos_fzp_2d
-
-  FUNCTION eos_fzp_0d( psal, pdep ) RESULT( ptf )
+      END SELECT      
+      !
+  END SUBROUTINE eos_fzp_2d
+
+  SUBROUTINE eos_fzp_0d( psal, ptf, pdep )
       !!----------------------------------------------------------------------
       !!                 ***  ROUTINE eos_fzp  ***
@@ -1054,7 +1055,7 @@
       !! Reference  :   UNESCO tech. papers in the marine science no. 28. 1978
       !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in)           ::   psal   ! salinity   [psu]
-      REAL(wp), INTENT(in), OPTIONAL ::   pdep   ! depth      [m]
-      REAL(wp)                       ::   ptf   ! freezing temperature [Celcius]
+      REAL(wp), INTENT(in )           ::   psal         ! salinity   [psu]
+      REAL(wp), INTENT(in ), OPTIONAL ::   pdep         ! depth      [m]
+      REAL(wp), INTENT(out)           ::   ptf          ! freezing temperature [Celcius]
       !
       REAL(wp) :: zs   ! local scalars
@@ -1086,5 +1087,5 @@
       END SELECT
       !
-   END FUNCTION eos_fzp_0d
+   END SUBROUTINE eos_fzp_0d
 
 
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90	(revision 6440)
@@ -173,5 +173,5 @@
          END DO 
       END DO 
-      zfzp(:,:) = eos_fzp( tsn(:,:,1,jp_sal), zpres(:,:) )
+      CALL eos_fzp( tsn(:,:,1,jp_sal), zfzp(:,:), zpres(:,:) )
       DO jk = 1, jpk
          DO jj = 1, jpj
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90	(revision 6440)
@@ -212,5 +212,6 @@
       CHARACTER(len=3) ::   cdtype
       REAL, DIMENSION(:,:,:) ::   pun, pvn, pwn
-      WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', kt, cdtype, pun(1,1,1), pvn(1,1,1), pwn(1,1,1)
+      WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', &
+          &  kt, cdtype, pun(1,1,1), pvn(1,1,1), pwn(1,1,1)
    END SUBROUTINE tra_adv_eiv
 #endif
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90	(revision 6440)
@@ -326,5 +326,5 @@
       CALL wrk_alloc( jpi, jpj, zwx_sav, zwy_sav )
       CALL wrk_alloc( jpi, jpj, jpk, zwi, zwz , zhdiv, zwz_sav, zwzts )
-      CALL wrk_alloc( jpi, jpj, jpk, 3, ztrs )
+      CALL wrk_alloc( jpi, jpj, jpk, kjpt+1, ztrs )
       !
       IF( kt == kit000 )  THEN
@@ -564,5 +564,5 @@
       !
                    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, jpk, kjpt+1, ztrs )
                    CALL wrk_dealloc( jpi, jpj, zwx_sav, zwy_sav )
       IF( l_trd )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90	(revision 6440)
@@ -68,4 +68,5 @@
       !
       rldf = 1     ! For active tracers the 
+      r_fact_lap(:,:,:) = 1.0
 
       IF( l_trdtra )   THEN                    !* Save ta and sa trends
@@ -214,4 +215,6 @@
       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( ln_traldf_grif .AND. ln_isfcav         )   &
+           CALL ctl_stop( ' ice shelf and traldf_grif not tested')
       IF( lk_traldf_eiv .AND. .NOT.ln_traldf_iso )   &
            CALL ctl_stop( '          eddy induced velocity on tracers',   &
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90	(revision 6440)
@@ -28,4 +28,5 @@
    USE sbc_oce         ! surface boundary condition: ocean
    USE sbcrnf          ! river runoffs
+   USE sbcisf          ! ice shelf melting/freezing
    USE zdf_oce         ! ocean vertical mixing
    USE domvvl          ! variable volume
@@ -46,5 +47,4 @@
    USE timing          ! Timing
 #if defined key_agrif
-   USE agrif_opa_update
    USE agrif_opa_interp
 #endif
@@ -110,4 +110,8 @@
       ! 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 )
@@ -115,7 +119,4 @@
 #if defined key_bdy 
       IF( lk_bdy )   CALL bdy_tra( kt )  ! BDY open boundaries
-#endif
-#if defined key_agrif
-      CALL Agrif_tra                     ! AGRIF zoom boundaries
 #endif
  
@@ -148,12 +149,7 @@
          ELSE                 ;   CALL tra_nxt_fix( kt, nit000,         'TRA', tsb, tsn, tsa, jpts )  ! fixed    volume level 
          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
+      ENDIF     
+      !
+     ! trends computation
       IF( l_trdtra ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt     
          DO jk = 1, jpkm1
@@ -279,5 +275,5 @@
 
       !!     
-      LOGICAL  ::   ll_tra_hpg, ll_traqsr, ll_rnf   ! local logical
+      LOGICAL  ::   ll_tra_hpg, 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
@@ -295,8 +291,14 @@
          ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration
          ll_rnf     = ln_rnf           ! active  tracers case  and  river runoffs
+         IF (nn_isf .GE. 1) THEN 
+            ll_isf = .TRUE.            ! active  tracers case  and  ice shelf melting/freezing
+         ELSE
+            ll_isf = .FALSE.
+         END IF
       ELSE                          
          ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg
          ll_traqsr  = .FALSE.          ! active  tracers case and NO solar penetration
          ll_rnf     = .FALSE.          ! passive tracers or NO river runoffs
+         ll_isf     = .FALSE.          ! passive tracers or NO ice shelf melting/freezing
       ENDIF
       !
@@ -321,15 +323,31 @@
                   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)
+
+                  ! ice shelf
+                  IF( ll_isf ) THEN
+                     ! level fully include in the Losch_2008 ice shelf boundary layer
+                     IF ( jk >= misfkt(ji,jj) .AND. jk < misfkb(ji,jj) )                          &
+                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
+                               &                 * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj)
+                     ! level partially include in Losch_2008 ice shelf boundary layer 
+                     IF ( jk == misfkb(ji,jj) )                                                   &
+                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
+                               &                 * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj)
+                  END IF
 
                   ze3t_f = 1.e0 / ze3t_f
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90	(revision 6440)
@@ -10,5 +10,6 @@
    !!             -   !  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.4  !  2012-05  (C. Rousset) store attenuation coef for use in ice model 
+   !!            3.6  !  2015-12  (O. Aumont, J. Jouanno, C. Ethe) use vertical profile of chlorophyll
    !!----------------------------------------------------------------------
 
@@ -93,4 +94,5 @@
       !! Reference  : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp.
       !!              Lengaigne et al. 2007, Clim. Dyn., V28, 5, 503-516.
+      !!              Morel, A. et Berthon, JF, 1989, Limnol Oceanogr 34(8), 1545-1562
       !!----------------------------------------------------------------------
       !
@@ -101,14 +103,15 @@
       REAL(wp) ::   zchl, zcoef, zfact   ! local scalars
       REAL(wp) ::   zc0, zc1, zc2, zc3   !    -         -
-      REAL(wp) ::   zzc0, zzc1, zzc2, zzc3   !    -         -
       REAL(wp) ::   zz0, zz1, z1_e3t     !    -         -
+      REAL(wp) ::   zCb, zCmax, zze, zpsi, zpsimax, zdelpsi, zCtot, zCze
+      REAL(wp) ::   zlogc, zlogc2, zlogc3 
       REAL(wp), POINTER, DIMENSION(:,:  ) :: zekb, zekg, zekr
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrdt
-      !!----------------------------------------------------------------------
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrdt, zchl3d
+      !!--------------------------------------------------------------------------
       !
       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 ) 
+      CALL wrk_alloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea, zchl3d ) 
       !
       IF( kt == nit000 ) THEN
@@ -183,31 +186,47 @@
             !                                             ! ------------------------- !
             ! 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
+            IF( nn_chldta == 1 .OR. nn_chldta == 2 .OR. lk_vvl ) THEN    !*  Variable Chlorophyll or ocean volume
+               !
+               IF( nn_chldta == 1 ) THEN        !*  2D Variable Chlorophyll
+                  !
+                  CALL fld_read( kt, 1, sf_chl )            ! Read Chl data and provides it at the current time step
+                  DO jk = 1, nksr + 1
+                     zchl3d(:,:,jk) = sf_chl(1)%fnow(:,:,1) 
+                  ENDDO
+                  !
+               ELSE IF( nn_chldta == 2 ) THEN    !*   -3-D Variable Chlorophyll
+                  !
+                  CALL fld_read( kt, 1, sf_chl )            ! Read Chl data and provides it at the current time step
+!CDIR NOVERRCHK   !
+                  DO jj = 1, jpj
 !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)
+                     DO ji = 1, jpi
+                        zchl    = sf_chl(1)%fnow(ji,jj,1)
+                        zCtot   = 40.6  * zchl**0.459
+                        zze     = 568.2 * zCtot**(-0.746)
+                        IF( zze > 102. ) zze = 200.0 * zCtot**(-0.293)
+                        zlogc   = LOG( zchl )
+                        zlogc2  = zlogc * zlogc
+                        zlogc3  = zlogc * zlogc * zlogc
+                        zCb     = 0.768 + 0.087 * zlogc - 0.179 * zlogc2 - 0.025 * zlogc3
+                        zCmax   = 0.299 - 0.289 * zlogc + 0.579 * zlogc2
+                        zpsimax = 0.6   - 0.640 * zlogc + 0.021 * zlogc2 + 0.115 * zlogc3
+                        zdelpsi = 0.710 + 0.159 * zlogc + 0.021 * zlogc2
+                        zCze    = 1.12  * (zchl)**0.803 
+                        DO jk = 1, nksr + 1
+                           zpsi = fsdept(ji,jj,jk) / zze
+                           zchl3d(ji,jj,jk) = zCze * ( zCb + zCmax * EXP( -( (zpsi - zpsimax) / zdelpsi )**2 ) )
+                        END DO
+                        !
+                      END DO
+                   END DO
+                     !
+               ELSE                              !* Variable ocean volume but constant chrlorophyll
+                  DO jk = 1, nksr + 1
+                     zchl3d(:,:,jk) = 0.05 
+                  ENDDO
                ENDIF
                !
-               zcoef  = ( 1. - rn_abs ) / 3.e0                        ! equi-partition in R-G-B
+               zcoef  = ( 1. - rn_abs ) / 3.e0                        !  equi-partition in R-G-B
                ze0(:,:,1) = rn_abs  * qsr(:,:)
                ze1(:,:,1) = zcoef * qsr(:,:)
@@ -217,4 +236,15 @@
                !
                DO jk = 2, nksr+1
+                  !
+                  DO jj = 1, jpj                                         ! Separation in R-G-B depending of vertical profile of Chl
+!CDIR NOVERRCHK
+                     DO ji = 1, jpi
+                        zchl = MIN( 10. , MAX( 0.03, zchl3d(ji,jj,jk) ) )
+                        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
 !CDIR NOVERRCHK
                   DO jj = 1, jpj
@@ -233,16 +263,4 @@
                   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
@@ -251,4 +269,29 @@
                zea(:,:,nksr+1:jpk) = 0.e0     ! below 400m set to zero
                CALL iom_put( 'qsr3d', zea )   ! Shortwave Radiation 3D distribution
+               !
+               IF ( ln_qsr_ice ) THEN    ! store attenuation coefficient of the first ocean level
+!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, zchl3d(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
+                  ! 
+                  DO jj = 1, jpj
+                     DO ji = 1, jpi
+                        zc0 = rn_abs * EXP( - fse3t(ji,jj,1) * xsi0r     )
+                        zc1 = zcoef  * EXP( - fse3t(ji,jj,1) * zekb(ji,jj) )
+                        zc2 = zcoef  * EXP( - fse3t(ji,jj,1) * zekg(ji,jj) )
+                        zc3 = zcoef  * EXP( - fse3t(ji,jj,1) * zekr(ji,jj) )
+                        fraqsr_1lev(ji,jj) = 1.0 - ( zc0 + zc1 + zc2  + zc3  ) * tmask(ji,jj,2) 
+                     END DO
+                  END DO
+                  !
+               ENDIF
                !
             ELSE                                                 !*  Constant Chlorophyll
@@ -256,6 +299,6 @@
                   qsr_hc(:,:,jk) =  etot3(:,:,jk) * qsr(:,:)
                END DO
-               ! clem: store attenuation coefficient of the first ocean level
-               IF ( ln_qsr_ice ) THEN
+               !  store attenuation coefficient of the first ocean level
+               IF( ln_qsr_ice ) THEN
                   fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp
                ENDIF
@@ -339,5 +382,5 @@
       !
       CALL wrk_dealloc( jpi, jpj,      zekb, zekg, zekr        ) 
-      CALL wrk_dealloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea ) 
+      CALL wrk_dealloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea, zchl3d ) 
       !
       IF( nn_timing == 1 )  CALL timing_stop('tra_qsr')
@@ -405,5 +448,5 @@
          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 : Chl data (=1/2) 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
@@ -429,13 +472,15 @@
          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( ln_qsr_rgb .AND. nn_chldta == 2 )   nqsr =  3
+         IF( ln_qsr_2bd                      )   nqsr =  4
+         IF( ln_qsr_bio                      )   nqsr =  5
          !
          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 ==  2 )   WRITE(numout,*) '         R-G-B   light penetration - 2D Chl data '
+            IF( nqsr ==  3 )   WRITE(numout,*) '         R-G-B   light penetration - 3D Chl data '
+            IF( nqsr ==  4 )   WRITE(numout,*) '         2 bands light penetration'
+            IF( nqsr ==  5 )   WRITE(numout,*) '         bio-model light penetration'
          ENDIF
          !
@@ -460,5 +505,5 @@
             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( nn_chldta == 1  .OR. nn_chldta == 2 ) THEN           !* Chl data : set sf_chl structure
                IF(lwp) WRITE(numout,*)
                IF(lwp) WRITE(numout,*) '        Chlorophyll read in a file'
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90	(revision 6440)
@@ -120,5 +120,4 @@
       REAL(wp) ::   zfact, z1_e3t, zdep
       REAL(wp) ::   zalpha, zhk
-      REAL(wp) ::  zt_frz, zpress
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds
       !!----------------------------------------------------------------------
@@ -232,11 +231,7 @@
                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) &
-                     &           * r1_hisf_tbl(ji,jj)
+                     &           + 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)
@@ -245,11 +240,7 @@
                ! 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) & 
-                  &              * r1_hisf_tbl(ji,jj) * ralpha(ji,jj)
+                  &              + 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) 
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90	(revision 6440)
@@ -117,28 +117,28 @@
       !
       SELECT CASE( ktrd )
-      	CASE( jpdyn_hpg )   ;   CALL iom_put( "ketrd_hpg", zke )    ! hydrostatic pressure gradient
-      	CASE( jpdyn_spg )   ;   CALL iom_put( "ketrd_spg", zke )    ! surface pressure gradient
-      	CASE( jpdyn_spgexp );   CALL iom_put( "ketrd_spgexp", zke ) ! surface pressure gradient (explicit)
-      	CASE( jpdyn_spgflt );   CALL iom_put( "ketrd_spgflt", zke ) ! surface pressure gradient (filter)
-      	CASE( jpdyn_pvo )   ;   CALL iom_put( "ketrd_pvo", zke )    ! planetary vorticity
-      	CASE( jpdyn_rvo )   ;   CALL iom_put( "ketrd_rvo", zke )    ! relative  vorticity     (or metric term)
-      	CASE( jpdyn_keg )   ;   CALL iom_put( "ketrd_keg", zke )    ! Kinetic Energy gradient (or had)
-      	CASE( jpdyn_zad )   ;   CALL iom_put( "ketrd_zad", zke )    ! vertical   advection
-      	CASE( jpdyn_ldf )   ;   CALL iom_put( "ketrd_ldf", zke )    ! lateral diffusion
-      	CASE( jpdyn_zdf )   ;   CALL iom_put( "ketrd_zdf", zke )    ! vertical diffusion 
+        CASE( jpdyn_hpg )   ;   CALL iom_put( "ketrd_hpg", zke )    ! hydrostatic pressure gradient
+        CASE( jpdyn_spg )   ;   CALL iom_put( "ketrd_spg", zke )    ! surface pressure gradient
+        CASE( jpdyn_spgexp );   CALL iom_put( "ketrd_spgexp", zke ) ! surface pressure gradient (explicit)
+        CASE( jpdyn_spgflt );   CALL iom_put( "ketrd_spgflt", zke ) ! surface pressure gradient (filter)
+        CASE( jpdyn_pvo )   ;   CALL iom_put( "ketrd_pvo", zke )    ! planetary vorticity
+        CASE( jpdyn_rvo )   ;   CALL iom_put( "ketrd_rvo", zke )    ! relative  vorticity     (or metric term)
+        CASE( jpdyn_keg )   ;   CALL iom_put( "ketrd_keg", zke )    ! Kinetic Energy gradient (or had)
+        CASE( jpdyn_zad )   ;   CALL iom_put( "ketrd_zad", zke )    ! vertical   advection
+        CASE( jpdyn_ldf )   ;   CALL iom_put( "ketrd_ldf", zke )    ! lateral diffusion
+        CASE( jpdyn_zdf )   ;   CALL iom_put( "ketrd_zdf", zke )    ! vertical diffusion 
                                  !                                   ! wind stress trends
-                              	CALL wrk_alloc( jpi, jpj, z2dx, z2dy, zke2d )
-         						z2dx(:,:) = un(:,:,1) * ( utau_b(:,:) + utau(:,:) ) * e1u(:,:) * e2u(:,:) * umask(:,:,1)
-         						z2dy(:,:) = vn(:,:,1) * ( vtau_b(:,:) + vtau(:,:) ) * e1v(:,:) * e2v(:,:) * vmask(:,:,1)
-         						zke2d(1,:) = 0._wp   ;   zke2d(:,1) = 0._wp
-         						DO jj = 2, jpj
-            					   DO ji = 2, jpi
-               						zke2d(ji,jj) = 0.5_wp * (   z2dx(ji,jj) + z2dx(ji-1,jj)   &
-                  					&                         + z2dy(ji,jj) + z2dy(ji,jj-1)   ) * r1_bt(ji,jj,1)
-            					   END DO
-         						END DO
-                              	CALL iom_put( "ketrd_tau", zke2d )
-                              	CALL wrk_dealloc( jpi, jpj     , z2dx, z2dy, zke2d )
-      	CASE( jpdyn_bfr )   ;   CALL iom_put( "ketrd_bfr", zke )    ! bottom friction (explicit case) 
+                                CALL wrk_alloc( jpi, jpj, z2dx, z2dy, zke2d )
+                     z2dx(:,:) = un(:,:,1) * ( utau_b(:,:) + utau(:,:) ) * e1u(:,:) * e2u(:,:) * umask(:,:,1)
+                     z2dy(:,:) = vn(:,:,1) * ( vtau_b(:,:) + vtau(:,:) ) * e1v(:,:) * e2v(:,:) * vmask(:,:,1)
+                     zke2d(1,:) = 0._wp   ;   zke2d(:,1) = 0._wp
+                     DO jj = 2, jpj
+                         DO ji = 2, jpi
+                           zke2d(ji,jj) = 0.5_wp * (   z2dx(ji,jj) + z2dx(ji-1,jj)   &
+                            &                         + z2dy(ji,jj) + z2dy(ji,jj-1)   ) * r1_bt(ji,jj,1)
+                         END DO
+                     END DO
+                                CALL iom_put( "ketrd_tau", zke2d )
+                                CALL wrk_dealloc( jpi, jpj     , z2dx, z2dy, zke2d )
+        CASE( jpdyn_bfr )   ;   CALL iom_put( "ketrd_bfr", zke )    ! bottom friction (explicit case) 
 !!gm TO BE DONE properly
 !!gm only valid if ln_bfrimp=F otherwise the bottom stress as to be recomputed at the end of the computation....
@@ -162,5 +162,5 @@
 !         ENDIF
 !!gm end
-      	CASE( jpdyn_atf )   ;   CALL iom_put( "ketrd_atf", zke )    ! asselin filter trends 
+        CASE( jpdyn_atf )   ;   CALL iom_put( "ketrd_atf", zke )    ! asselin filter trends 
 !! a faire !!!!  idee changer dynnxt pour avoir un appel a jpdyn_bfr avant le swap !!!
 !! reflechir a une possible sauvegarde du "vrai" un,vn pour le calcul de atf....
@@ -184,12 +184,12 @@
 !                              CALL iom_put( "ketrd_bfri", zke2d )
 !         ENDIF
-      	CASE( jpdyn_ken )   ;   ! kinetic energy
-      							! called in dynnxt.F90 before asselin time filter
-      							! with putrd=ua and pvtrd=va
-      							zke(:,:,:) = 0.5_wp * zke(:,:,:)
-      							CALL iom_put( "KE", zke )
-      							!
-      							CALL ken_p2k( kt , zke )
-            					CALL iom_put( "ketrd_convP2K", zke )     ! conversion -rau*g*w
+        CASE( jpdyn_ken )   ;   ! kinetic energy
+                    ! called in dynnxt.F90 before asselin time filter
+                    ! with putrd=ua and pvtrd=va
+                    zke(:,:,:) = 0.5_wp * zke(:,:,:)
+                    CALL iom_put( "KE", zke )
+                    !
+                    CALL ken_p2k( kt , zke )
+                      CALL iom_put( "ketrd_convP2K", zke )     ! conversion -rau*g*w
          !
       END SELECT
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90	(revision 6440)
@@ -165,11 +165,11 @@
 
 
-		SELECT CASE( ktrd )
-		CASE( jptra_npc  )               ! non-penetrative convection: regrouped with zdf
+      SELECT CASE( ktrd )
+      CASE( jptra_npc  )               ! non-penetrative convection: regrouped with zdf
 !!gm : to be completed ! 
-!		   IF( ....
+!         IF( ....
 !!gm end
-		CASE( jptra_zdfp )               ! iso-neutral diffusion: "pure" vertical diffusion
-		   !                                   ! regroup iso-neutral diffusion in one term
+      CASE( jptra_zdfp )               ! iso-neutral diffusion: "pure" vertical diffusion
+         !                                   ! regroup iso-neutral diffusion in one term
          tmltrd(:,:,jpmxl_ldf) = tmltrd(:,:,jpmxl_ldf) + ( tmltrd(:,:,jpmxl_zdf) - tmltrd(:,:,jpmxl_zdfp) )
          smltrd(:,:,jpmxl_ldf) = smltrd(:,:,jpmxl_ldf) + ( smltrd(:,:,jpmxl_zdf) - smltrd(:,:,jpmxl_zdfp) )
@@ -811,5 +811,5 @@
 
 
-   	nkstp     = nit000 - 1              ! current time step indicator initialization
+      nkstp     = nit000 - 1              ! current time step indicator initialization
 
 
@@ -851,5 +851,5 @@
       IF( nn_ctls == 1 ) THEN
          CALL ctl_opn( inum, 'ctlsurf_idx', 'OLD', 'UNFORMATTED', 'SEQUENTIAL', -1, numout, lwp )
-         READ ( inum ) nbol
+         READ ( inum, * ) nbol
          CLOSE( inum )
       END IF
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_oce.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_oce.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_oce.F90	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90	(revision 6440)
@@ -99,7 +99,7 @@
                                    CALL wrk_alloc( jpi, jpj, z2d )
                                    z2d(:,:) = wn(:,:,1) * ( &
-                                   	  &   - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * tsn(:,:,1,jp_tem)    &
-                                   	  &   + ( rab_n(:,:,1,jp_sal) + rab_pe(:,:,1,jp_sal) ) * tsn(:,:,1,jp_sal)    &
-                                      &   					) / fse3t(:,:,1)
+                                       &   - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * tsn(:,:,1,jp_tem)    &
+                                       &   + ( rab_n(:,:,1,jp_sal) + rab_pe(:,:,1,jp_sal) ) * tsn(:,:,1,jp_sal)    &
+                                       &             ) / fse3t(:,:,1)
                                    CALL iom_put( "petrd_sad" , z2d )
                                    CALL wrk_dealloc( jpi, jpj, z2d )
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90	(revision 6440)
@@ -43,4 +43,7 @@
    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]
  
    !!----------------------------------------------------------------------
@@ -60,5 +63,8 @@
          &     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 )
+         &     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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90	(revision 6440)
@@ -177,5 +177,10 @@
                   &                             +  0.15 * zrau(ji,jj)          * zmskd2(ji,jj)  )
                ! add to the eddy viscosity coef. previously computed
+# if defined key_zdftmx_new
+               ! key_zdftmx_new: New internal wave-driven param: use avs value computed by zdftmx
+               avs (ji,jj,jk) = avs(ji,jj,jk) + zavfs + zavds
+# else
                avs (ji,jj,jk) = avt(ji,jj,jk) + zavfs + zavds
+# endif
                avt (ji,jj,jk) = avt(ji,jj,jk) + zavft + zavdt
                avm (ji,jj,jk) = avm(ji,jj,jk) + MAX( zavft + zavdt, zavfs + zavds )
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90	(revision 6440)
@@ -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
@@ -120,8 +115,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 )
@@ -329,5 +322,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(:,:)+fsdepw(:,:,2)) &
+          &            / zhsro(:,:) )**(1.5_wp*ra_sf))**(2._wp/3._wp)
       en(:,:,2) = MAX(en(:,:,2), rn_emin )
       z_elem_a(:,:,2) = 0._wp 
@@ -350,5 +344,6 @@
       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)
+      zflxs(:,:)      = rsbc_tke2 * ustars2(:,:)**1.5_wp * zkar(:,:) &
+           &                      * ((zhsro(:,:)+fsdept(:,:,1))/zhsro(:,:) )**(1.5_wp*ra_sf)
 
       en(:,:,2) = en(:,:,2) + zflxs(:,:)/fse3w(:,:,2)
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90	(revision 6440)
@@ -27,4 +27,5 @@
 
    PUBLIC   zdf_mxl       ! called by step.F90
+   PUBLIC   zdf_mxl_alloc ! Used in zdf_tke_init
 
    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   nmln    !: number of level in the mixed layer (used by TOP)
@@ -79,7 +80,7 @@
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
       !
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      INTEGER  ::   iikn, iiki, ikt, imkt   ! local integer
-      REAL(wp) ::   zN2_c        ! local scalar
+      INTEGER  ::   ji, jj, jk      ! dummy loop indices
+      INTEGER  ::   iikn, iiki, ikt ! local integer
+      REAL(wp) ::   zN2_c           ! local scalar
       INTEGER, POINTER, DIMENSION(:,:) ::   imld   ! 2D workspace
       !!----------------------------------------------------------------------
@@ -116,6 +117,5 @@
          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
@@ -126,13 +126,25 @@
             iiki = imld(ji,jj)
             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) = fsdepw(ji,jj,iiki  ) * ssmask(ji,jj)    ! Turbocline depth 
+            hmlp (ji,jj) = fsdepw(ji,jj,iikn  ) * ssmask(ji,jj)    ! Mixed layer depth
+            hmlpt(ji,jj) = fsdept(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
+      ! no need to output in offline mode
+      IF( .NOT.lk_offline ) THEN   
+         IF ( iom_use("mldr10_1") ) THEN
+            IF( ln_isfcav ) THEN
+               CALL iom_put( "mldr10_1", hmlp - risfdep)   ! mixed layer thickness
+            ELSE
+               CALL iom_put( "mldr10_1", hmlp )            ! mixed layer depth
+            END IF
+         END IF
+         IF ( iom_use("mldkz5") ) THEN
+            IF( ln_isfcav ) THEN
+               CALL iom_put( "mldkz5"  , hmld - risfdep )   ! turbocline thickness
+            ELSE
+               CALL iom_put( "mldkz5"  , hmld )             ! turbocline depth
+            END IF
+         END IF
       ENDIF
       
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90	(revision 6440)
@@ -53,4 +53,10 @@
    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 +91,6 @@
    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
 #if defined key_c1d
    !                                                                        !!** 1D cfg only  **   ('key_c1d')
@@ -115,7 +118,5 @@
          &      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) , STAT= zdf_tke_alloc      )
          !
       IF( lk_mpp             )   CALL mpp_sum ( zdf_tke_alloc )
@@ -189,4 +190,9 @@
       avmv_k(:,:,:) = avmv(:,:,:) 
       !
+#if defined key_agrif
+      ! Update child grid f => parent grid 
+      IF( .NOT.Agrif_Root() )   CALL Agrif_Update_Tke( kt )      ! children only
+#endif      
+     ! 
    END SUBROUTINE zdf_tke
 
@@ -317,5 +323,6 @@
                   zwlc = zind * rn_lc * zus * SIN( rpi * fsdepw(ji,jj,jk) / zhlc(ji,jj) )
                   !                                           ! TKE Langmuir circulation source term
-                  en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( 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
@@ -350,8 +357,16 @@
             DO ji = fs_2, fs_jpim1   ! vector opt.
                zcof   = zfact1 * tmask(ji,jj,jk)
+# if defined key_zdftmx_new
+               ! key_zdftmx_new: New internal wave-driven param: set a minimum value for Kz on TKE (ensure numerical stability)
+               zzd_up = zcof * ( MAX( avm(ji,jj,jk+1) + avm(ji,jj,jk), 2.e-5_wp ) )   &  ! upper diagonal
+                  &          / ( fse3t(ji,jj,jk  ) * fse3w(ji,jj,jk  ) )
+               zzd_lw = zcof * ( MAX( avm(ji,jj,jk) + avm(ji,jj,jk-1), 2.e-5_wp ) )   &  ! lower diagonal
+                  &          / ( fse3t(ji,jj,jk-1) * fse3w(ji,jj,jk  ) )
+# else
                zzd_up = zcof * ( avm  (ji,jj,jk+1) + avm  (ji,jj,jk  ) )   &  ! upper diagonal
                   &          / ( fse3t(ji,jj,jk  ) * fse3w(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  ) )
+# endif
                   !                                                           ! 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) )   &
@@ -710,5 +725,5 @@
       !!----------------------------------------------------------------------
       INTEGER ::   ji, jj, jk   ! dummy loop indices
-      INTEGER ::   ios
+      INTEGER ::   ios, ierr
       !!
       NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb , rn_emin  ,   &
@@ -728,5 +743,16 @@
       !
       ri_cri   = 2._wp    / ( 2._wp + rn_ediss / rn_ediff )   ! resulting critical Richardson number
+# if defined key_zdftmx_new
+      ! key_zdftmx_new: New internal wave-driven param: specified value of rn_emin & rmxl_min are used
+      rn_emin  = 1.e-10_wp
+      rmxl_min = 1.e-03_wp
+      IF(lwp) THEN                  ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'zdf_tke_init :  New tidal mixing case: force rn_emin = 1.e-10 and rmxl_min = 1.e-3 '
+         WRITE(numout,*) '~~~~~~~~~~~~'
+      ENDIF
+# else
       rmxl_min = 1.e-6_wp / ( rn_ediff * SQRT( rn_emin ) )    ! resulting minimum length to recover molecular viscosity
+# endif
       !
       IF(lwp) THEN                    !* Control print
@@ -768,5 +794,8 @@
       ENDIF
       
-      IF( nn_etau == 2  )   CALL zdf_mxl( nit000 )      ! Initialization of nmln 
+      IF( nn_etau == 2  ) THEN
+          ierr = zdf_mxl_alloc()
+          nmln(:,:) = nlb10           ! Initialization of nmln
+      ENDIF
 
       !                               !* depth of penetration of surface tke
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90	(revision 6440)
@@ -561,4 +561,492 @@
    END SUBROUTINE zdf_tmx_init
 
+#elif defined key_zdftmx_new
+   !!----------------------------------------------------------------------
+   !!   'key_zdftmx_new'               Internal wave-driven vertical mixing
+   !!----------------------------------------------------------------------
+   !!   zdf_tmx       : global     momentum & tracer Kz with wave induced Kz
+   !!   zdf_tmx_init  : global     momentum & tracer Kz with wave induced Kz
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean space and time domain variables
+   USE zdf_oce        ! ocean vertical physics variables
+   USE zdfddm         ! ocean vertical physics: double diffusive mixing
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE eosbn2         ! ocean equation of state
+   USE phycst         ! physical constants
+   USE prtctl         ! Print control
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O Manager
+   USE lib_mpp        ! MPP library
+   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_tmx         ! called in step module 
+   PUBLIC   zdf_tmx_init    ! called in nemogcm module 
+   PUBLIC   zdf_tmx_alloc   ! called in nemogcm module
+
+   LOGICAL, PUBLIC, PARAMETER ::   lk_zdftmx = .TRUE.    !: wave-driven mixing flag
+
+   !                       !!* Namelist  namzdf_tmx : internal wave-driven mixing *
+   INTEGER  ::  nn_zpyc     ! pycnocline-intensified mixing energy proportional to N (=1) or N^2 (=2)
+   LOGICAL  ::  ln_mevar    ! variable (=T) or constant (=F) mixing efficiency
+   LOGICAL  ::  ln_tsdiff   ! account for differential T/S wave-driven mixing (=T) or not (=F)
+
+   REAL(wp) ::  r1_6 = 1._wp / 6._wp
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ebot_tmx     ! power available from high-mode wave breaking (W/m2)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   epyc_tmx     ! power available from low-mode, pycnocline-intensified wave breaking (W/m2)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ecri_tmx     ! power available from low-mode, critical slope wave breaking (W/m2)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hbot_tmx     ! WKB decay scale for high-mode energy dissipation (m)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hcri_tmx     ! decay scale for low-mode critical slope dissipation (m)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   emix_tmx     ! local energy density available for mixing (W/kg)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   bflx_tmx     ! buoyancy flux Kz * N^2 (W/kg)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   pcmap_tmx    ! vertically integrated buoyancy flux (W/m2)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   zav_ratio    ! S/T diffusivity ratio (only for ln_tsdiff=T)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   zav_wave     ! Internal wave-induced diffusivity
+
+   !! * Substitutions
+#  include "zdfddm_substitute.h90"
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION zdf_tmx_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  FUNCTION zdf_tmx_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE(     ebot_tmx(jpi,jpj),  epyc_tmx(jpi,jpj),  ecri_tmx(jpi,jpj)    ,   &
+      &             hbot_tmx(jpi,jpj),  hcri_tmx(jpi,jpj),  emix_tmx(jpi,jpj,jpk),   &
+      &         bflx_tmx(jpi,jpj,jpk), pcmap_tmx(jpi,jpj), zav_ratio(jpi,jpj,jpk),   & 
+      &         zav_wave(jpi,jpj,jpk), STAT=zdf_tmx_alloc     )
+      !
+      IF( lk_mpp             )   CALL mpp_sum ( zdf_tmx_alloc )
+      IF( zdf_tmx_alloc /= 0 )   CALL ctl_warn('zdf_tmx_alloc: failed to allocate arrays')
+   END FUNCTION zdf_tmx_alloc
+
+
+   SUBROUTINE zdf_tmx( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdf_tmx  ***
+      !!                   
+      !! ** Purpose :   add to the vertical mixing coefficients the effect of
+      !!              breaking internal waves.
+      !!
+      !! ** Method  : - internal wave-driven vertical mixing is given by:
+      !!                  Kz_wave = min(  100 cm2/s, f(  Reb = emix_tmx /( Nu * N^2 )  )
+      !!              where emix_tmx is the 3D space distribution of the wave-breaking 
+      !!              energy and Nu the molecular kinematic viscosity.
+      !!              The function f(Reb) is linear (constant mixing efficiency)
+      !!              if the namelist parameter ln_mevar = F and nonlinear if ln_mevar = T.
+      !!
+      !!              - Compute emix_tmx, the 3D power density that allows to compute
+      !!              Reb and therefrom the wave-induced vertical diffusivity.
+      !!              This is divided into three components:
+      !!                 1. Bottom-intensified low-mode dissipation at critical slopes
+      !!                     emix_tmx(z) = ( ecri_tmx / rau0 ) * EXP( -(H-z)/hcri_tmx )
+      !!                                   / ( 1. - EXP( - H/hcri_tmx ) ) * hcri_tmx
+      !!              where hcri_tmx is the characteristic length scale of the bottom 
+      !!              intensification, ecri_tmx a map of available power, and H the ocean depth.
+      !!                 2. Pycnocline-intensified low-mode dissipation
+      !!                     emix_tmx(z) = ( epyc_tmx / rau0 ) * ( sqrt(rn2(z))^nn_zpyc )
+      !!                                   / SUM( sqrt(rn2(z))^nn_zpyc * e3w(z) )
+      !!              where epyc_tmx is a map of available power, and nn_zpyc
+      !!              is the chosen stratification-dependence of the internal wave
+      !!              energy dissipation.
+      !!                 3. WKB-height dependent high mode dissipation
+      !!                     emix_tmx(z) = ( ebot_tmx / rau0 ) * rn2(z) * EXP(-z_wkb(z)/hbot_tmx)
+      !!                                   / SUM( rn2(z) * EXP(-z_wkb(z)/hbot_tmx) * e3w(z) )
+      !!              where hbot_tmx is the characteristic length scale of the WKB bottom 
+      !!              intensification, ebot_tmx is a map of available power, and z_wkb is the
+      !!              WKB-stretched height above bottom defined as
+      !!                    z_wkb(z) = H * SUM( sqrt(rn2(z'>=z)) * e3w(z'>=z) )
+      !!                                 / SUM( sqrt(rn2(z'))    * e3w(z')    )
+      !!
+      !!              - update the model vertical eddy viscosity and diffusivity: 
+      !!                     avt  = avt  +    av_wave
+      !!                     avm  = avm  +    av_wave
+      !!                     avmu = avmu + mi(av_wave)
+      !!                     avmv = avmv + mj(av_wave)
+      !!
+      !!              - if namelist parameter ln_tsdiff = T, account for differential mixing:
+      !!                     avs  = avt  +    av_wave * diffusivity_ratio(Reb)
+      !!
+      !! ** Action  : - Define emix_tmx used to compute internal wave-induced mixing
+      !!              - avt, avs, avm, avmu, avmv increased by internal wave-driven mixing    
+      !!
+      !! References :  de Lavergne et al. 2015, JPO; 2016, in prep.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step 
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   ztpc         ! scalar workspace
+      REAL(wp), DIMENSION(:,:)  , POINTER ::  zfact     ! Used for vertical structure
+      REAL(wp), DIMENSION(:,:)  , POINTER ::  zhdep     ! Ocean depth
+      REAL(wp), DIMENSION(:,:,:), POINTER ::  zwkb      ! WKB-stretched height above bottom
+      REAL(wp), DIMENSION(:,:,:), POINTER ::  zweight   ! Weight for high mode vertical distribution
+      REAL(wp), DIMENSION(:,:,:), POINTER ::  znu_t     ! Molecular kinematic viscosity (T grid)
+      REAL(wp), DIMENSION(:,:,:), POINTER ::  znu_w     ! Molecular kinematic viscosity (W grid)
+      REAL(wp), DIMENSION(:,:,:), POINTER ::  zReb      ! Turbulence intensity parameter
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('zdf_tmx')
+      !
+      CALL wrk_alloc( jpi,jpj,       zfact, zhdep )
+      CALL wrk_alloc( jpi,jpj,jpk,   zwkb, zweight, znu_t, znu_w, zReb )
+
+      !                          ! ----------------------------- !
+      !                          !  Internal wave-driven mixing  !  (compute zav_wave)
+      !                          ! ----------------------------- !
+      !                             
+      !                        !* Critical slope mixing: distribute energy over the time-varying ocean depth,
+      !                                                 using an exponential decay from the seafloor.
+      DO jj = 1, jpj                ! part independent of the level
+         DO ji = 1, jpi
+            zhdep(ji,jj) = fsdepw(ji,jj,mbkt(ji,jj)+1)       ! depth of the ocean
+            zfact(ji,jj) = rau0 * (  1._wp - EXP( -zhdep(ji,jj) / hcri_tmx(ji,jj) )  )
+            IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = ecri_tmx(ji,jj) / zfact(ji,jj)
+         END DO
+      END DO
+
+      DO jk = 2, jpkm1              ! complete with the level-dependent part
+         emix_tmx(:,:,jk) = zfact(:,:) * (  EXP( ( fsde3w(:,:,jk  ) - zhdep(:,:) ) / hcri_tmx(:,:) )                      &
+            &                             - EXP( ( fsde3w(:,:,jk-1) - zhdep(:,:) ) / hcri_tmx(:,:) )  ) * wmask(:,:,jk)   &
+            &                          / ( fsde3w(:,:,jk) - fsde3w(:,:,jk-1) )
+      END DO
+
+      !                        !* Pycnocline-intensified mixing: distribute energy over the time-varying 
+      !                        !* ocean depth as proportional to sqrt(rn2)^nn_zpyc
+
+      SELECT CASE ( nn_zpyc )
+
+      CASE ( 1 )               ! Dissipation scales as N (recommended)
+
+         zfact(:,:) = 0._wp
+         DO jk = 2, jpkm1              ! part independent of the level
+            zfact(:,:) = zfact(:,:) + fse3w(:,:,jk) * SQRT(  MAX( 0._wp, rn2(:,:,jk) )  ) * wmask(:,:,jk)
+         END DO
+
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = epyc_tmx(ji,jj) / ( rau0 * zfact(ji,jj) )
+            END DO
+         END DO
+
+         DO jk = 2, jpkm1              ! complete with the level-dependent part
+            emix_tmx(:,:,jk) = emix_tmx(:,:,jk) + zfact(:,:) * SQRT(  MAX( 0._wp, rn2(:,:,jk) )  ) * wmask(:,:,jk)
+         END DO
+
+      CASE ( 2 )               ! Dissipation scales as N^2
+
+         zfact(:,:) = 0._wp
+         DO jk = 2, jpkm1              ! part independent of the level
+            zfact(:,:) = zfact(:,:) + fse3w(:,:,jk) * MAX( 0._wp, rn2(:,:,jk) ) * wmask(:,:,jk)
+         END DO
+
+         DO jj= 1, jpj
+            DO ji = 1, jpi
+               IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = epyc_tmx(ji,jj) / ( rau0 * zfact(ji,jj) )
+            END DO
+         END DO
+
+         DO jk = 2, jpkm1              ! complete with the level-dependent part
+            emix_tmx(:,:,jk) = emix_tmx(:,:,jk) + zfact(:,:) * MAX( 0._wp, rn2(:,:,jk) ) * wmask(:,:,jk)
+         END DO
+
+      END SELECT
+
+      !                        !* WKB-height dependent mixing: distribute energy over the time-varying 
+      !                        !* ocean depth as proportional to rn2 * exp(-z_wkb/rn_hbot)
+      
+      zwkb(:,:,:) = 0._wp
+      zfact(:,:) = 0._wp
+      DO jk = 2, jpkm1
+         zfact(:,:) = zfact(:,:) + fse3w(:,:,jk) * SQRT(  MAX( 0._wp, rn2(:,:,jk) )  ) * wmask(:,:,jk)
+         zwkb(:,:,jk) = zfact(:,:)
+      END DO
+
+      DO jk = 2, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( zfact(ji,jj) /= 0 )   zwkb(ji,jj,jk) = zhdep(ji,jj) * ( zfact(ji,jj) - zwkb(ji,jj,jk) )   &
+                                            &           * tmask(ji,jj,jk) / zfact(ji,jj)
+            END DO
+         END DO
+      END DO
+      zwkb(:,:,1) = zhdep(:,:) * tmask(:,:,1)
+
+      zweight(:,:,:) = 0._wp
+      DO jk = 2, jpkm1
+         zweight(:,:,jk) = MAX( 0._wp, rn2(:,:,jk) ) * hbot_tmx(:,:) * wmask(:,:,jk)                    &
+            &   * (  EXP( -zwkb(:,:,jk) / hbot_tmx(:,:) ) - EXP( -zwkb(:,:,jk-1) / hbot_tmx(:,:) )  )
+      END DO
+
+      zfact(:,:) = 0._wp
+      DO jk = 2, jpkm1              ! part independent of the level
+         zfact(:,:) = zfact(:,:) + zweight(:,:,jk)
+      END DO
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = ebot_tmx(ji,jj) / ( rau0 * zfact(ji,jj) )
+         END DO
+      END DO
+
+      DO jk = 2, jpkm1              ! complete with the level-dependent part
+         emix_tmx(:,:,jk) = emix_tmx(:,:,jk) + zweight(:,:,jk) * zfact(:,:) * wmask(:,:,jk)   &
+            &                                / ( fsde3w(:,:,jk) - fsde3w(:,:,jk-1) )
+      END DO
+
+
+      ! Calculate molecular kinematic viscosity
+      znu_t(:,:,:) = 1.e-4_wp * (  17.91_wp - 0.53810_wp * tsn(:,:,:,jp_tem) + 0.00694_wp * tsn(:,:,:,jp_tem) * tsn(:,:,:,jp_tem)  &
+         &                                  + 0.02305_wp * tsn(:,:,:,jp_sal)  ) * tmask(:,:,:) * r1_rau0
+      DO jk = 2, jpkm1
+         znu_w(:,:,jk) = 0.5_wp * ( znu_t(:,:,jk-1) + znu_t(:,:,jk) ) * wmask(:,:,jk)
+      END DO
+
+      ! Calculate turbulence intensity parameter Reb
+      DO jk = 2, jpkm1
+         zReb(:,:,jk) = emix_tmx(:,:,jk) / MAX( 1.e-20_wp, znu_w(:,:,jk) * rn2(:,:,jk) )
+      END DO
+
+      ! Define internal wave-induced diffusivity
+      DO jk = 2, jpkm1
+         zav_wave(:,:,jk) = znu_w(:,:,jk) * zReb(:,:,jk) * r1_6   ! This corresponds to a constant mixing efficiency of 1/6
+      END DO
+
+      IF( ln_mevar ) THEN              ! Variable mixing efficiency case : modify zav_wave in the
+         DO jk = 2, jpkm1              ! energetic (Reb > 480) and buoyancy-controlled (Reb <10.224 ) regimes
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  IF( zReb(ji,jj,jk) > 480.00_wp ) THEN
+                     zav_wave(ji,jj,jk) = 3.6515_wp * znu_w(ji,jj,jk) * SQRT( zReb(ji,jj,jk) )
+                  ELSEIF( zReb(ji,jj,jk) < 10.224_wp ) THEN
+                     zav_wave(ji,jj,jk) = 0.052125_wp * znu_w(ji,jj,jk) * zReb(ji,jj,jk) * SQRT( zReb(ji,jj,jk) )
+                  ENDIF
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      DO jk = 2, jpkm1                 ! Bound diffusivity by molecular value and 100 cm2/s
+         zav_wave(:,:,jk) = MIN(  MAX( 1.4e-7_wp, zav_wave(:,:,jk) ), 1.e-2_wp  ) * wmask(:,:,jk)
+      END DO
+
+      IF( kt == nit000 ) THEN        !* Control print at first time-step: diagnose the energy consumed by zav_wave
+         ztpc = 0._wp
+         DO jk = 2, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ztpc = ztpc + fse3w(ji,jj,jk) * e1e2t(ji,jj)   &
+                     &         * MAX( 0._wp, rn2(ji,jj,jk) ) * zav_wave(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 * ztpc ! Global integral of rauo * Kz * N^2 = power contributing to mixing 
+ 
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'zdf_tmx : Internal wave-driven mixing (tmx)'
+            WRITE(numout,*) '~~~~~~~ '
+            WRITE(numout,*)
+            WRITE(numout,*) '      Total power consumption by av_wave: ztpc =  ', ztpc * 1.e-12_wp, 'TW'
+         ENDIF
+      ENDIF
+
+      !                          ! ----------------------- !
+      !                          !   Update  mixing coefs  !                          
+      !                          ! ----------------------- !
+      !      
+      IF( ln_tsdiff ) THEN          !* Option for differential mixing of salinity and temperature
+         DO jk = 2, jpkm1              ! Calculate S/T diffusivity ratio as a function of Reb
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zav_ratio(ji,jj,jk) = ( 0.505_wp + 0.495_wp *                                                                  &
+                      &   TANH(    0.92_wp * (   LOG10(  MAX( 1.e-20_wp, zReb(ji,jj,jk) * 5._wp * r1_6 )  ) - 0.60_wp   )    )   &
+                      &                 ) * wmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         CALL iom_put( "av_ratio", zav_ratio )
+         DO jk = 2, jpkm1           !* update momentum & tracer diffusivity with wave-driven mixing
+            fsavs(:,:,jk) = avt(:,:,jk) + zav_wave(:,:,jk) * zav_ratio(:,:,jk)
+            avt  (:,:,jk) = avt(:,:,jk) + zav_wave(:,:,jk)
+            avm  (:,:,jk) = avm(:,:,jk) + zav_wave(:,:,jk)
+         END DO
+         !
+      ELSE                          !* update momentum & tracer diffusivity with wave-driven mixing
+         DO jk = 2, jpkm1
+            fsavs(:,:,jk) = avt(:,:,jk) + zav_wave(:,:,jk)
+            avt  (:,:,jk) = avt(:,:,jk) + zav_wave(:,:,jk)
+            avm  (:,:,jk) = avm(:,:,jk) + zav_wave(:,:,jk)
+         END DO
+      ENDIF
+
+      DO jk = 2, jpkm1              !* update momentum diffusivity at wu and wv points
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1  ! vector opt.
+               avmu(ji,jj,jk) = avmu(ji,jj,jk) + 0.5_wp * ( zav_wave(ji,jj,jk) + zav_wave(ji+1,jj  ,jk) ) * wumask(ji,jj,jk)
+               avmv(ji,jj,jk) = avmv(ji,jj,jk) + 0.5_wp * ( zav_wave(ji,jj,jk) + zav_wave(ji  ,jj+1,jk) ) * wvmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. )      ! lateral boundary condition
+
+      !                             !* output internal wave-driven mixing coefficient
+      CALL iom_put( "av_wave", zav_wave )
+                                    !* output useful diagnostics: N^2, Kz * N^2 (bflx_tmx), 
+                                    !  vertical integral of rau0 * Kz * N^2 (pcmap_tmx), energy density (emix_tmx)
+      IF( iom_use("bflx_tmx") .OR. iom_use("pcmap_tmx") ) THEN
+         bflx_tmx(:,:,:) = MAX( 0._wp, rn2(:,:,:) ) * zav_wave(:,:,:)
+         pcmap_tmx(:,:) = 0._wp
+         DO jk = 2, jpkm1
+            pcmap_tmx(:,:) = pcmap_tmx(:,:) + fse3w(:,:,jk) * bflx_tmx(:,:,jk) * wmask(:,:,jk)
+         END DO
+         pcmap_tmx(:,:) = rau0 * pcmap_tmx(:,:)
+         CALL iom_put( "bflx_tmx", bflx_tmx )
+         CALL iom_put( "pcmap_tmx", pcmap_tmx )
+      ENDIF
+      CALL iom_put( "bn2", rn2 )
+      CALL iom_put( "emix_tmx", emix_tmx )
+      
+      CALL wrk_dealloc( jpi,jpj,       zfact, zhdep )
+      CALL wrk_dealloc( jpi,jpj,jpk,   zwkb, zweight, znu_t, znu_w, zReb )
+
+      IF(ln_ctl)   CALL prt_ctl(tab3d_1=zav_wave , clinfo1=' tmx - av_wave: ', tab3d_2=avt, clinfo2=' avt: ', ovlap=1, kdim=jpk)
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('zdf_tmx')
+      !
+   END SUBROUTINE zdf_tmx
+
+
+   SUBROUTINE zdf_tmx_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdf_tmx_init  ***
+      !!                     
+      !! ** Purpose :   Initialization of the wave-driven vertical mixing, reading
+      !!              of input power maps and decay length scales in netcdf files.
+      !!
+      !! ** Method  : - Read the namzdf_tmx namelist and check the parameters
+      !!
+      !!              - Read the input data in NetCDF files :
+      !!              power available from high-mode wave breaking (mixing_power_bot.nc)
+      !!              power available from pycnocline-intensified wave-breaking (mixing_power_pyc.nc)
+      !!              power available from critical slope wave-breaking (mixing_power_cri.nc)
+      !!              WKB decay scale for high-mode wave-breaking (decay_scale_bot.nc)
+      !!              decay scale for critical slope wave-breaking (decay_scale_cri.nc)
+      !!
+      !! ** input   : - Namlist namzdf_tmx
+      !!              - NetCDF files : mixing_power_bot.nc, mixing_power_pyc.nc, mixing_power_cri.nc,
+      !!              decay_scale_bot.nc decay_scale_cri.nc
+      !!
+      !! ** Action  : - Increase by 1 the nstop flag is setting problem encounter
+      !!              - Define ebot_tmx, epyc_tmx, ecri_tmx, hbot_tmx, hcri_tmx
+      !!
+      !! References : de Lavergne et al. 2015, JPO; 2016, in prep.
+      !!			  
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      INTEGER  ::   inum         ! local integer
+      INTEGER  ::   ios
+      REAL(wp) ::   zbot, zpyc, zcri   ! local scalars
+      !!
+      NAMELIST/namzdf_tmx_new/ nn_zpyc, ln_mevar, ln_tsdiff
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zdf_tmx_init')
+      !
+      REWIND( numnam_ref )              ! Namelist namzdf_tmx in reference namelist : Wave-driven mixing
+      READ  ( numnam_ref, namzdf_tmx_new, 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 : Wave-driven mixing
+      READ  ( numnam_cfg, namzdf_tmx_new, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_tmx in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namzdf_tmx_new )
+      !
+      IF(lwp) THEN                  ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'zdf_tmx_init : internal wave-driven mixing'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namzdf_tmx_new : set wave-driven mixing parameters'
+         WRITE(numout,*) '      Pycnocline-intensified diss. scales as N (=1) or N^2 (=2) = ', nn_zpyc
+         WRITE(numout,*) '      Variable (T) or constant (F) mixing efficiency            = ', ln_mevar
+         WRITE(numout,*) '      Differential internal wave-driven mixing (T) or not (F)   = ', ln_tsdiff
+      ENDIF
+      
+      ! The new wave-driven mixing parameterization elevates avt and avm in the interior, and
+      ! ensures that avt remains larger than its molecular value (=1.4e-7). Therefore, avtb should 
+      ! be set here to a very small value, and avmb to its (uniform) molecular value (=1.4e-6).
+      avmb(:) = 1.4e-6_wp        ! viscous molecular value
+      avtb(:) = 1.e-10_wp        ! very small diffusive minimum (background avt is specified in zdf_tmx)    
+      avtb_2d(:,:) = 1.e0_wp     ! uniform 
+      IF(lwp) THEN                  ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) '   Force the background value applied to avm & avt in TKE to be everywhere ',   &
+            &               'the viscous molecular value & a very small diffusive value, resp.'
+      ENDIF
+      
+      IF( .NOT.lk_zdfddm )   CALL ctl_stop( 'STOP', 'zdf_tmx_init_new : key_zdftmx_new requires key_zdfddm' )
+      
+      !                             ! allocate tmx arrays
+      IF( zdf_tmx_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_tmx_init : unable to allocate tmx arrays' )
+      !
+      !                             ! read necessary fields
+      CALL iom_open('mixing_power_bot',inum)       ! energy flux for high-mode wave breaking [W/m2]
+      CALL iom_get  (inum, jpdom_data, 'field', ebot_tmx, 1 ) 
+      CALL iom_close(inum)
+      !
+      CALL iom_open('mixing_power_pyc',inum)       ! energy flux for pynocline-intensified wave breaking [W/m2]
+      CALL iom_get  (inum, jpdom_data, 'field', epyc_tmx, 1 )
+      CALL iom_close(inum)
+      !
+      CALL iom_open('mixing_power_cri',inum)       ! energy flux for critical slope wave breaking [W/m2]
+      CALL iom_get  (inum, jpdom_data, 'field', ecri_tmx, 1 )
+      CALL iom_close(inum)
+      !
+      CALL iom_open('decay_scale_bot',inum)        ! spatially variable decay scale for high-mode wave breaking [m]
+      CALL iom_get  (inum, jpdom_data, 'field', hbot_tmx, 1 )
+      CALL iom_close(inum)
+      !
+      CALL iom_open('decay_scale_cri',inum)        ! spatially variable decay scale for critical slope wave breaking [m]
+      CALL iom_get  (inum, jpdom_data, 'field', hcri_tmx, 1 )
+      CALL iom_close(inum)
+
+      ebot_tmx(:,:) = ebot_tmx(:,:) * ssmask(:,:)
+      epyc_tmx(:,:) = epyc_tmx(:,:) * ssmask(:,:)
+      ecri_tmx(:,:) = ecri_tmx(:,:) * ssmask(:,:)
+
+      ! Set once for all to zero the first and last vertical levels of appropriate variables
+      emix_tmx (:,:, 1 ) = 0._wp
+      emix_tmx (:,:,jpk) = 0._wp
+      zav_ratio(:,:, 1 ) = 0._wp
+      zav_ratio(:,:,jpk) = 0._wp
+      zav_wave (:,:, 1 ) = 0._wp
+      zav_wave (:,:,jpk) = 0._wp
+
+      zbot = glob_sum( e1e2t(:,:) * ebot_tmx(:,:) )
+      zpyc = glob_sum( e1e2t(:,:) * epyc_tmx(:,:) )
+      zcri = glob_sum( e1e2t(:,:) * ecri_tmx(:,:) )
+      IF(lwp) THEN
+         WRITE(numout,*) '      High-mode wave-breaking energy:             ', zbot * 1.e-12_wp, 'TW'
+         WRITE(numout,*) '      Pycnocline-intensifed wave-breaking energy: ', zpyc * 1.e-12_wp, 'TW'
+         WRITE(numout,*) '      Critical slope wave-breaking energy:        ', zcri * 1.e-12_wp, 'TW'
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zdf_tmx_init')
+      !
+   END SUBROUTINE zdf_tmx_init
+
 #else
    !!----------------------------------------------------------------------
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 6440)
@@ -161,7 +161,11 @@
           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
@@ -187,8 +191,10 @@
       !
 #if defined key_agrif
-      CALL Agrif_ParentGrid_To_ChildGrid()
-      IF( lk_diaobs ) CALL dia_obs_wri
-      IF( nn_timing == 1 )   CALL timing_finalize
-      CALL Agrif_ChildGrid_To_ParentGrid()
+      IF( .NOT. Agrif_Root() ) THEN
+         CALL Agrif_ParentGrid_To_ChildGrid()
+         IF( lk_diaobs ) CALL dia_obs_wri
+         IF( nn_timing == 1 )   CALL timing_finalize
+         CALL Agrif_ChildGrid_To_ParentGrid()
+      ENDIF
 #endif
       IF( nn_timing == 1 )   CALL timing_finalize
@@ -334,6 +340,14 @@
          jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   ! second dim.
 #endif
-      ENDIF
+      ENDIF         
          jpk = jpkdta                                             ! third dim
+#if defined key_agrif
+         ! simple trick to use same vertical grid as parent
+         ! but different number of levels: 
+         ! Save maximum number of levels in jpkdta, then define all vertical grids
+         ! with this number.
+         ! Suppress once vertical online interpolation is ok
+         IF(.NOT.Agrif_Root()) jpkdta = Agrif_Parent(jpkdta)
+#endif
          jpim1 = jpi-1                                            ! inner domain indices
          jpjm1 = jpj-1                                            !   "           "
@@ -710,10 +724,11 @@
       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  /
-      !!----------------------------------------------------------------------
+      INTEGER, DIMENSION(ntest) :: ilfax
+      !
+      ! ilfax contains the set of allowed factors.
+      ilfax(:) = (/(2**jl,jl=ntest,1,-1)/)
+      !!----------------------------------------------------------------------
+      ! ilfax contains the set of allowed factors.
+      ilfax(:) = (/(2**jl,jl=ntest,1,-1)/)
 
       ! Clear the error flag and initialise output vars
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/step.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/step.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/step.F90	(revision 6440)
@@ -50,5 +50,5 @@
 
 #if defined key_agrif
-   SUBROUTINE stp( )
+   RECURSIVE SUBROUTINE stp( )
       INTEGER             ::   kstp   ! ocean time-step index
 #else
@@ -79,7 +79,11 @@
 #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 ( 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 )
@@ -110,5 +114,6 @@
       ! Update stochastic parameters and random T/S fluctuations
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-                        CALL sto_par( kstp )          ! Stochastic parameters
+       IF( ln_sto_eos ) CALL sto_par( kstp )          ! Stochastic parameters
+       IF( ln_sto_eos ) CALL sto_pts( tsn  )          ! Random T/S fluctuations
 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -152,5 +157,4 @@
       !
       IF( lk_ldfslp ) THEN                            ! slope of lateral mixing
-         IF(ln_sto_eos ) CALL sto_pts( tsn )          ! Random T/S fluctuations
                          CALL eos( tsb, rhd, gdept_0(:,:,:) )               ! before in situ density
          IF( ln_zps .AND. .NOT. ln_isfcav)                               &
@@ -188,5 +192,4 @@
           ! 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)                               &
@@ -200,5 +203,5 @@
                                   ua(:,:,:) = 0.e0             ! set dynamics trends to zero
                                   va(:,:,:) = 0.e0
-          IF(  ln_asmiau .AND. &
+          IF(  lk_asminc .AND. 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)
@@ -248,5 +251,5 @@
                              tsa(:,:,:,:) = 0.e0            ! set tracer trends to zero
 
-      IF(  ln_asmiau .AND. &
+      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
@@ -270,5 +273,4 @@
          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)                                &
@@ -281,5 +283,4 @@
       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)                                   &
@@ -314,5 +315,5 @@
                                va(:,:,:) = 0.e0
 
-        IF(  ln_asmiau .AND. &
+        IF(  lk_asminc .AND. 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
@@ -335,10 +336,24 @@
                                CALL ssh_swp( kstp )         ! swap of sea surface height
       IF( lk_vvl           )   CALL dom_vvl_sf_swp( kstp )  ! swap of vertical scale factors
-
+      !
+      IF( lrst_oce         )   CALL rst_write( kstp )       ! write output ocean restart file
+      IF( ln_sto_eos       )   CALL sto_rst_write( kstp )   ! write restart file for stochastic parameters
+
+#if defined key_agrif
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! AGRIF
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<      
+                               CALL Agrif_Integrate_ChildGrids( stp )  
+
+      IF ( Agrif_NbStepint().EQ.0 ) THEN
+                               CALL Agrif_Update_Tra()      ! Update active tracers
+                               CALL Agrif_Update_Dyn()      ! Update momentum
+      ENDIF
+#endif
       IF( ln_diahsb        )   CALL dia_hsb( kstp )         ! - ML - global conservation diagnostics
       IF( lk_diaobs  )         CALL dia_obs( kstp )         ! obs-minus-model (assimilation) diagnostics (call after dynamics update)
 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! Control and restarts
+      ! Control
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
                                CALL stp_ctl( kstp, indic )
@@ -352,5 +367,4 @@
          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
 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -367,4 +381,5 @@
       !
       IF( nn_timing == 1 .AND.  kstp == nit000  )   CALL timing_reset
+      !     
       !
    END SUBROUTINE stp
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/step_oce.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/step_oce.F90	(revision 6440)
@@ -112,4 +112,5 @@
 #if defined key_agrif
    USE agrif_opa_sponge ! Momemtum and tracers sponges
+   USE agrif_opa_update ! Update (2-way nesting)
 #endif
 #if defined key_top
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/stpctl.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/stpctl.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/OPA_SRC/stpctl.F90	(revision 6440)
@@ -17,4 +17,5 @@
    USE dom_oce         ! ocean space and time domain variables 
    USE sol_oce         ! ocean space and time domain variables 
+   USE sbc_oce         ! surface boundary conditions variables
    USE in_out_manager  ! I/O manager
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
@@ -22,4 +23,5 @@
    USE dynspg_oce      ! pressure gradient schemes 
    USE c1d             ! 1D vertical configuration
+
 
    IMPLICIT NONE
@@ -52,4 +54,5 @@
       INTEGER, INTENT( inout ) ::   kindic  ! indicator of solver convergence
       !!
+      CHARACTER(len = 32) ::        clfname ! time stepping output file name
       INTEGER  ::   ji, jj, jk              ! dummy loop indices
       INTEGER  ::   ii, ij, ik              ! temporary integers
@@ -63,6 +66,11 @@
          WRITE(numout,*) 'stp_ctl : time-stepping control'
          WRITE(numout,*) '~~~~~~~'
-         ! open time.step file
-         CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
+         ! open time.step file with special treatment for SAS
+         IF ( nn_components == jp_iam_sas ) THEN
+            clfname = 'time.step.sas'
+         ELSE
+            clfname = 'time.step'
+         ENDIF
+         CALL ctl_opn( numstp, TRIM(clfname), 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
       ENDIF
 
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/SAS_SRC/daymod.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/SAS_SRC/daymod.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/SAS_SRC/daymod.F90	(revision 6440)
@@ -71,4 +71,9 @@
       !!----------------------------------------------------------------------
       !
+      ! max number of seconds between each restart
+      IF( REAL( nitend - nit000 + 1 ) * rdt > REAL( HUGE( nsec1jan000 ) ) ) THEN
+         CALL ctl_stop( 'The number of seconds between each restart exceeds the integer 4 max value: 2^31-1. ',   &
+            &           'You must do a restart at higher frequency (or remove this stop and recompile the code in I8)' )
+      ENDIF
       ! all calendar staff is based on the fact that MOD( rday, rdttra(1) ) == 0
       IF( MOD( rday     , rdttra(1) ) /= 0. )   CALL ctl_stop( 'the time step must devide the number of second of in a day' )
@@ -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
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90	(revision 6440)
@@ -599,3 +599,3 @@
 
    !!======================================================================
-END MODULE  p2zbio
+END MODULE p2zbio
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90	(revision 6440)
@@ -84,3 +84,3 @@
 
    !!======================================================================
-END MODULE  p2zsms
+END MODULE p2zsms
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90	(revision 6440)
@@ -109,4 +109,3 @@
 
    !!======================================================================
-END MODULE  p4zbio
-
+END MODULE p4zbio
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90	(revision 6440)
@@ -31,6 +31,6 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sio3eq   ! chemistry of Si
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   fekeq    ! chemistry of Fe
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   chemc    ! Solubilities of O2 and CO2
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   chemo2    ! Solubilities of O2 and CO2
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   chemc    ! Solubilities of O2 and CO2
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   chemo2   ! Solubilities of O2 and CO2
 
    REAL(wp), PUBLIC ::   atcox  = 0.20946         ! units atm
@@ -76,46 +76,7 @@
    REAL(wp) ::   st1    =      0.14     ! constants for calculate concentrations for sulfate
    REAL(wp) ::   st2    =  1./96.062    !  (Morris & Riley 1966)
-   REAL(wp) ::   ks0    =    141.328 
-   REAL(wp) ::   ks1    =  -4276.1  
-   REAL(wp) ::   ks2    =    -23.093
-   REAL(wp) ::   ks3    = -13856.  
-   REAL(wp) ::   ks4    =   324.57 
-   REAL(wp) ::   ks5    =   -47.986
-   REAL(wp) ::   ks6    =  35474. 
-   REAL(wp) ::   ks7    =   -771.54
-   REAL(wp) ::   ks8    =    114.723
-   REAL(wp) ::   ks9    =  -2698.  
-   REAL(wp) ::   ks10   =   1776. 
-   REAL(wp) ::   ks11   =      1.
-   REAL(wp) ::   ks12   =     -0.001005 
 
    REAL(wp) ::   ft1    =    0.000067   ! constants for calculate concentrations for fluorides
    REAL(wp) ::   ft2    = 1./18.9984    ! (Dickson & Riley 1979 )
-   REAL(wp) ::   kf0    =  -12.641    
-   REAL(wp) ::   kf1    = 1590.2    
-   REAL(wp) ::   kf2    =    1.525    
-   REAL(wp) ::   kf3    =    1.0     
-   REAL(wp) ::   kf4    =   -0.001005
-
-   REAL(wp) ::   cb0    = -8966.90      ! Coeff. for 1. dissoc. of boric acid 
-   REAL(wp) ::   cb1    = -2890.53      ! (Dickson and Goyet, 1994)
-   REAL(wp) ::   cb2    =   -77.942
-   REAL(wp) ::   cb3    =     1.728
-   REAL(wp) ::   cb4    =    -0.0996
-   REAL(wp) ::   cb5    =   148.0248
-   REAL(wp) ::   cb6    =   137.1942
-   REAL(wp) ::   cb7    =     1.62142
-   REAL(wp) ::   cb8    =   -24.4344
-   REAL(wp) ::   cb9    =   -25.085
-   REAL(wp) ::   cb10   =    -0.2474 
-   REAL(wp) ::   cb11   =     0.053105
-
-   REAL(wp) ::   cw0    = -13847.26     ! Coeff. for dissoc. of water (Dickson and Riley, 1979 )
-   REAL(wp) ::   cw1    =    148.9652  
-   REAL(wp) ::   cw2    =    -23.6521
-   REAL(wp) ::   cw3    =    118.67 
-   REAL(wp) ::   cw4    =     -5.977 
-   REAL(wp) ::   cw5    =      1.0495  
-   REAL(wp) ::   cw6    =     -0.01615
 
    !                                    ! volumetric solubility constants for o2 in ml/L  
@@ -200,5 +161,5 @@
          DO ji = 1, jpi
             !                             ! SET ABSOLUTE TEMPERATURE
-            ztkel = tsn(ji,jj,1,jp_tem) + 273.16
+            ztkel = tsn(ji,jj,1,jp_tem) + 273.15
             zt    = ztkel * 0.01
             zt2   = zt * zt
@@ -209,16 +170,6 @@
             !                             !     AND FOR THE ATMOSPHERE FOR NON IDEAL GAS
             zcek1 = ca0 + ca1 / zt + ca2 * zlogt + ca3 * zt2 + zsal * ( ca4 + ca5 * zt + ca6 * zt2 )
-            !                             ! LN(K0) OF SOLUBILITY OF O2 and N2 in ml/L (EQ. 8, GARCIA AND GORDON, 1992)
-            ztgg  = LOG( ( 298.15 - tsn(ji,jj,1,jp_tem) ) / ztkel )  ! Set the GORDON & GARCIA scaled temperature
-            ztgg2 = ztgg  * ztgg
-            ztgg3 = ztgg2 * ztgg
-            ztgg4 = ztgg3 * ztgg
-            ztgg5 = ztgg4 * ztgg
-            zoxy  = ox0 + ox1 * ztgg + ox2 * ztgg2 + ox3 * ztgg3 + ox4 * ztgg4 + ox5 * ztgg5   &
-                   + zsal * ( ox6 + ox7 * ztgg + ox8 * ztgg2 + ox9 * ztgg3 ) +  ox10 * zsal2
-
             !                             ! SET SOLUBILITIES OF O2 AND CO2 
-            chemc(ji,jj,1) = EXP( zcek1 ) * 1.e-6 * rhop(ji,jj,1) / 1000.  ! mol/(L uatm)
-            chemc(ji,jj,2) = ( EXP( zoxy  ) * o2atm ) * oxyco              ! mol/(L atm)
+            chemc(ji,jj) = EXP( zcek1 ) * 1.e-6 * rhop(ji,jj,1) / 1000.  ! mol/(L uatm)
             !
          END DO
@@ -233,5 +184,5 @@
 !CDIR NOVERRCHK
             DO ji = 1, jpi
-              ztkel = tsn(ji,jj,jk,jp_tem) + 273.16
+              ztkel = tsn(ji,jj,jk,jp_tem) + 273.15
               zsal  = tsn(ji,jj,jk,jp_sal) + ( 1.- tmask(ji,jj,jk) ) * 35.
               zsal2 = zsal * zsal
@@ -263,5 +214,5 @@
 
                ! SET ABSOLUTE TEMPERATURE
-               ztkel   = tsn(ji,jj,jk,jp_tem) + 273.16
+               ztkel   = tsn(ji,jj,jk,jp_tem) + 273.15
                zsal    = tsn(ji,jj,jk,jp_sal) + ( 1.-tmask(ji,jj,jk) ) * 35.
                zsqrt  = SQRT( zsal )
@@ -284,17 +235,24 @@
 
                ! DISSOCIATION CONSTANT FOR SULFATES on free H scale (Dickson 1990)
-               zcks    = EXP(  ks1 * ztr + ks0 + ks2 * zlogt                           &
-                  &                     + ( ks3 * ztr + ks4 + ks5 * zlogt ) * zisqrt   &
-                  &                     + ( ks6 * ztr + ks7 + ks8 * zlogt ) * zis      &
-                  &                     + ks9 * ztr * zis * zisqrt + ks10 * ztr *zis2 + LOG( ks11 + ks12 *zsal )  )
+               zcks    = EXP(-4276.1 * ztr + 141.328 - 23.093 * zlogt         &
+               &         + (-13856. * ztr + 324.57 - 47.986 * zlogt) * zisqrt &
+               &         + (35474. * ztr - 771.54 + 114.723 * zlogt) * zis    &
+               &         - 2698. * ztr * zis**1.5 + 1776.* ztr * zis2         &
+               &         + LOG(1.0 - 0.001005 * zsal))
+               !
+               aphscale(ji,jj,jk) = ( 1. + zst / zcks )
 
                ! DISSOCIATION CONSTANT FOR FLUORIDES on free H scale (Dickson and Riley 79)
-               zckf    = EXP(  kf1 * ztr + kf0 + kf2 * zisqrt + LOG( kf3 + kf4 * zsal )  )
+               zckf    = EXP( 1590.2*ztr - 12.641 + 1.525*zisqrt   &
+               &         + LOG(1.0d0 - 0.001005d0*zsal)            &
+               &         + LOG(1.0d0 + zst/zcks))
 
                ! DISSOCIATION CONSTANT FOR CARBONATE AND BORATE
-               zckb    = ( cb0 + cb1 * zsqrt + cb2  * zsal + cb3 * zsal15 + cb4 * zsal * zsal ) * ztr   &
-                  &    + ( cb5 + cb6 * zsqrt + cb7  * zsal )                                            &
-                  &    + ( cb8 + cb9 * zsqrt + cb10 * zsal ) * zlogt + cb11 * zsqrt * ztkel             &
-                  &    + LOG(  ( 1.+ zst / zcks + zft / zckf ) / ( 1.+ zst / zcks )  )
+               zckb=  (-8966.90 - 2890.53*zsqrt - 77.942*zsal        &
+               &      + 1.728*zsal15 - 0.0996*zsal*zsal)*ztr         &
+               &      + (148.0248 + 137.1942*zsqrt + 1.62142*zsal)   &
+               &      + (-24.4344 - 25.085*zsqrt - 0.2474*zsal)      & 
+               &      * zlogt + 0.053105*zsqrt*ztkel
+
 
                zck1    = c10 * ztr + c11 + c12 * zlogt + c13 * zsal + c14 * zsal * zsal
@@ -302,6 +260,7 @@
 
                ! PKW (H2O) (DICKSON AND RILEY, 1979)
-               zckw    = cw0 * ztr + cw1 + cw2 * zlogt + ( cw3 * ztr + cw4 + cw5 * zlogt ) * zsqrt + cw6 * zsal
-
+               zckw = -13847.26*ztr + 148.9652 - 23.6521 * zlogt    & 
+               &     + (118.67*ztr - 5.977 + 1.0495 * zlogt)        &
+               &     * zsqrt - 0.01615 * zsal
 
                ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE IN SEAWATER
@@ -378,5 +337,6 @@
       !!                     ***  ROUTINE p4z_che_alloc  ***
       !!----------------------------------------------------------------------
-      ALLOCATE( sio3eq(jpi,jpj,jpk), fekeq(jpi,jpj,jpk), chemc(jpi,jpj,2), chemo2(jpi,jpj,jpk), STAT=p4z_che_alloc )
+      ALLOCATE( sio3eq(jpi,jpj,jpk), fekeq(jpi,jpj,jpk), chemc(jpi,jpj), chemo2(jpi,jpj,jpk),   &
+      &         STAT=p4z_che_alloc )
       !
       IF( p4z_che_alloc /= 0 )   CALL ctl_warn('p4z_che_alloc : failed to allocate arrays.')
@@ -396,3 +356,3 @@
 
    !!======================================================================
-END MODULE  p4zche
+END MODULE p4zche
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90	(revision 6440)
@@ -84,5 +84,5 @@
       !
       INTEGER  ::   ji, jj, jm, iind, iindm1
-      REAL(wp) ::   ztc, ztc2, ztc3, zws, zkgwan
+      REAL(wp) ::   ztc, ztc2, ztc3, ztc4, zws, zkgwan
       REAL(wp) ::   zfld, zflu, zfld16, zflu16, zfact
       REAL(wp) ::   zph, zah2, zbot, zdic, zalk, zsch_o2, zalka, zsch_co2
@@ -135,5 +135,6 @@
 
                ! CALCULATE [ALK]([CO3--], [HCO3-])
-               zalk  = zalka - (  akw3(ji,jj,1) / zph - zph + zbot / ( 1.+ zph / akb3(ji,jj,1) )  )
+               zalk  = zalka - (  akw3(ji,jj,1) / zph - zph / aphscale(ji,jj,1)    &
+               &       + zbot / ( 1.+ zph / akb3(ji,jj,1) )  )
 
                ! CALCULATE [H+] AND [H2CO3]
@@ -162,11 +163,12 @@
             ztc2 = ztc * ztc
             ztc3 = ztc * ztc2 
+            ztc4 = ztc2 * ztc2 
             ! Compute the schmidt Number both O2 and CO2
-            zsch_co2 = 2073.1 - 125.62 * ztc + 3.6276 * ztc2 - 0.043126 * ztc3
-            zsch_o2  = 1953.4 - 128.0  * ztc + 3.9918 * ztc2 - 0.050091 * ztc3
+            zsch_co2 = 2116.8 - 136.25 * ztc + 4.7353 * ztc2 - 0.092307 * ztc3 + 0.0007555 * ztc4
+            zsch_o2  = 1920.4 - 135.6  * ztc + 5.2122 * ztc2 - 0.109390 * ztc3 + 0.0009377 * ztc4
             !  wind speed 
             zws  = wndm(ji,jj) * wndm(ji,jj)
             ! Compute the piston velocity for O2 and CO2
-            zkgwan = 0.3 * zws  + 2.5 * ( 0.5246 + 0.016256 * ztc + 0.00049946  * ztc2 )
+            zkgwan = 0.251 * zws
             zkgwan = zkgwan * xconv * ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1)
 # if defined key_degrad
@@ -182,5 +184,5 @@
          DO ji = 1, jpi
             ! Compute CO2 flux for the sea and air
-            zfld = satmco2(ji,jj) * patm(ji,jj) * tmask(ji,jj,1) * chemc(ji,jj,1) * zkgco2(ji,jj)   ! (mol/L) * (m/s)
+            zfld = satmco2(ji,jj) * patm(ji,jj) * tmask(ji,jj,1) * chemc(ji,jj) * zkgco2(ji,jj)   ! (mol/L) * (m/s)
             zflu = zh2co3(ji,jj) * tmask(ji,jj,1) * zkgco2(ji,jj)                                   ! (mol/L) (m/s) ?
             oce_co2(ji,jj) = ( zfld - zflu ) * rfact2 * e1e2t(ji,jj) * tmask(ji,jj,1) * 1000.
@@ -189,5 +191,5 @@
 
             ! Compute O2 flux 
-            zfld16 = atcox * patm(ji,jj) * chemc(ji,jj,2) * tmask(ji,jj,1) * zkgo2(ji,jj)          ! (mol/L) * (m/s)
+            zfld16 = patm(ji,jj) * chemo2(ji,jj,1) * tmask(ji,jj,1) * zkgo2(ji,jj)          ! (mol/L) * (m/s)
             zflu16 = trb(ji,jj,1,jpoxy) * tmask(ji,jj,1) * zkgo2(ji,jj)
             zoflx(ji,jj) = zfld16 - zflu16
@@ -222,9 +224,9 @@
          ENDIF
          IF( iom_use( "Dpco2" ) ) THEN
-           zw2d(:,:) = ( satmco2(:,:) * patm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1)
+           zw2d(:,:) = ( satmco2(:,:) * patm(:,:) - zh2co3(:,:) / ( chemc(:,:) + rtrn ) ) * tmask(:,:,1)
            CALL iom_put( "Dpco2" ,  zw2d )
          ENDIF
          IF( iom_use( "Dpo2" ) )  THEN
-           zw2d(:,:) = ( atcox * patm(:,:) - trb(:,:,1,jpoxy) / ( chemc(:,:,2) + rtrn ) ) * tmask(:,:,1)
+           zw2d(:,:) = ( atcox * patm(:,:) - atcox * trn(:,:,1,jpoxy) / ( chemo2(:,:,1) + rtrn ) ) * tmask(:,:,1)
            CALL iom_put( "Dpo2"  , zw2d )
          ENDIF
@@ -238,5 +240,5 @@
             trc2d(:,:,jp_pcs0_2d + 1) = zoflx(:,:) * 1000 * tmask(:,:,1) 
             trc2d(:,:,jp_pcs0_2d + 2) = zkgco2(:,:) * tmask(:,:,1) 
-            trc2d(:,:,jp_pcs0_2d + 3) = ( satmco2(:,:) * patm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1) 
+            trc2d(:,:,jp_pcs0_2d + 3) = ( satmco2(:,:) * patm(:,:) - zh2co3(:,:) / ( chemc(:,:) + rtrn ) ) * tmask(:,:,1) 
          ENDIF
       ENDIF
@@ -400,3 +402,3 @@
 
    !!======================================================================
-END MODULE  p4zflx
+END MODULE p4zflx
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90	(revision 6440)
@@ -81,3 +81,3 @@
 
    !!======================================================================
-END MODULE  p4zint
+END MODULE p4zint
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90	(revision 6440)
@@ -265,3 +265,3 @@
 
    !!======================================================================
-END MODULE  p4zlim
+END MODULE p4zlim
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90	(revision 6440)
@@ -91,5 +91,6 @@
                   zalka = trb(ji,jj,jk,jptal) / zfact
                   ! CALCULATE [ALK]([CO3--], [HCO3-])
-                  zalk  = zalka - ( akw3(ji,jj,jk) / zph - zph + borat(ji,jj,jk) / ( 1. + zph / akb3(ji,jj,jk) ) )
+                  zalk  = zalka - ( akw3(ji,jj,jk) / zph - zph / ( aphscale(ji,jj,jk) + rtrn )  &
+                  &       + borat(ji,jj,jk) / ( 1. + zph / akb3(ji,jj,jk) ) )
                   ! CALCULATE [H+] and [CO3--]
                   zaldi = zdic - zalk
@@ -152,7 +153,9 @@
          IF( iom_use( "DCAL"   ) ) CALL iom_put( "DCAL"  , zcaldiss(:,:,:) * 1.e+3 * rfact2r   * tmask(:,:,:) )
       ELSE
-         trc3d(:,:,:,jp_pcs0_3d    ) = -1. * LOG10( hi(:,:,:) ) * tmask(:,:,:)
-         trc3d(:,:,:,jp_pcs0_3d + 1) = zco3(:,:,:)              * tmask(:,:,:)
-         trc3d(:,:,:,jp_pcs0_3d + 2) = aksp(:,:,:) / calcon     * tmask(:,:,:)
+         IF( ln_diatrc ) THEN
+            trc3d(:,:,:,jp_pcs0_3d    ) = -1. * LOG10( hi(:,:,:) ) * tmask(:,:,:)
+            trc3d(:,:,:,jp_pcs0_3d + 1) = zco3(:,:,:)              * tmask(:,:,:)
+            trc3d(:,:,:,jp_pcs0_3d + 2) = aksp(:,:,:) / calcon     * tmask(:,:,:)
+         ENDIF
       ENDIF
       !
@@ -223,3 +226,3 @@
 #endif 
    !!======================================================================
-END MODULE  p4zlys
+END MODULE p4zlys
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90	(revision 6440)
@@ -340,3 +340,3 @@
 
    !!======================================================================
-END MODULE  p4zmeso
+END MODULE p4zmeso
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90	(revision 6440)
@@ -273,3 +273,3 @@
 
    !!======================================================================
-END MODULE  p4zmicro
+END MODULE p4zmicro
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90	(revision 6440)
@@ -277,3 +277,3 @@
 
    !!======================================================================
-END MODULE  p4zmort
+END MODULE p4zmort
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90	(revision 6440)
@@ -439,3 +439,3 @@
 
    !!======================================================================
-END MODULE  p4zopt
+END MODULE p4zopt
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90	(revision 6440)
@@ -629,3 +629,3 @@
 
    !!======================================================================
-END MODULE  p4zprod
+END MODULE p4zprod
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90	(revision 6440)
@@ -519,3 +519,3 @@
 
    !!======================================================================
-END MODULE  p4zsbc
+END MODULE p4zsbc
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90	(revision 6440)
@@ -72,4 +72,5 @@
       CHARACTER (len=25) :: charout
       REAL(wp), POINTER, DIMENSION(:,:  ) :: zpdep, zsidep, zwork1, zwork2, zwork3
+      REAL(wp), POINTER, DIMENSION(:,:)   :: zsedcal, zsedsi, zsedc
       REAL(wp), POINTER, DIMENSION(:,:  ) :: zdenit2d, zironice, zbureff
       REAL(wp), POINTER, DIMENSION(:,:  ) :: zwsbio3, zwsbio4, zwscal
@@ -83,4 +84,5 @@
       ! Allocate temporary workspace
       CALL wrk_alloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff )
+      CALL wrk_alloc( jpi, jpj, zsedcal,  zsedsi, zsedc )
       CALL wrk_alloc( jpi, jpj, zwsbio3, zwsbio4, zwscal )
       CALL wrk_alloc( jpi, jpj, jpk, zsoufer )
@@ -91,4 +93,7 @@
       zwork2  (:,:) = 0.e0
       zwork3  (:,:) = 0.e0
+      zsedsi   (:,:) = 0.e0
+      zsedcal  (:,:) = 0.e0
+      zsedc    (:,:) = 0.e0
 
       ! Iron input/uptake due to sea ice : Crude parameterization based on Lancelot et al.
@@ -298,4 +303,6 @@
             tra(ji,jj,ikt,jptal) =  tra(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0
             tra(ji,jj,ikt,jpdic) =  tra(ji,jj,ikt,jpdic) + zcaloss * zrivalk
+            zsedcal(ji,jj) = (1.0 - zrivalk) * zcaloss / zdep
+            zsedsi (ji,jj) = (1.0 - zrivsil) * zsiloss / zdep
 #endif
          END DO
@@ -336,5 +343,6 @@
             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 / zdep
+            zsedc(ji,jj)   = (1. - zrivno3) * zwstpoc / zdep
 #endif
          END DO
@@ -392,4 +400,8 @@
                CALL iom_put( "INTNFIX" , zwork1 ) 
             ENDIF
+            IF( iom_use("SedCal" ) ) CALL iom_put( "SedCal", zsedcal(:,:) * 1.e+3 )
+            IF( iom_use("SedSi" ) )  CALL iom_put( "SedSi",  zsedsi (:,:) * 1.e+3 )
+            IF( iom_use("SedC" ) )   CALL iom_put( "SedC",   zsedc  (:,:) * 1.e+3 )
+            IF( iom_use("Sdenit" ) ) CALL iom_put( "Sdenit", sdenit (:,:) * 1.e+3 * rno3 )
          ENDIF
       ELSE
@@ -405,4 +417,5 @@
       !
       CALL wrk_dealloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff )
+      CALL wrk_dealloc( jpi, jpj, zsedcal , zsedsi, zsedc )
       CALL wrk_dealloc( jpi, jpj, zwsbio3, zwsbio4, zwscal )
       CALL wrk_dealloc( jpi, jpj, jpk, zsoufer )
@@ -436,3 +449,3 @@
 
    !!======================================================================
-END MODULE  p4zsed
+END MODULE p4zsed
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90	(revision 6440)
@@ -913,3 +913,3 @@
 
    !!======================================================================
-END MODULE  p4zsink
+END MODULE p4zsink
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90	(revision 6440)
@@ -38,5 +38,5 @@
 
    REAL(wp) :: alkbudget, no3budget, silbudget, ferbudget, po4budget
-   REAL(wp) :: xfact1, xfact2
+   REAL(wp) :: xfact1, xfact2, xfact3
    INTEGER ::  numco2, numnut, numnit  !: logical unit for co2 budget
 
@@ -133,6 +133,6 @@
          !
          CALL p4z_bio( kt, jnt )   ! Biology
-         CALL p4z_sed( kt, jnt )   ! Sedimentation
          CALL p4z_lys( kt, jnt )   ! Compute CaCO3 saturation
+         CALL p4z_sed( kt, jnt )   ! Surface and Bottom boundary conditions
          CALL p4z_flx( kt, jnt )   ! Compute surface fluxes
          !
@@ -474,7 +474,6 @@
       !!---------------------------------------------------------------------
       !
-      INTEGER , INTENT( in ) ::   kt      ! ocean time-step index      
-      REAL(wp)               ::  zfact       
-      REAL(wp) ::  zrdenittot, zsdenittot, znitrpottot
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index      
+      REAL(wp)             ::  zrdenittot, zsdenittot, znitrpottot
       CHARACTER(LEN=100)   ::   cltxt
       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol
@@ -492,4 +491,5 @@
             xfact1 = rfact2r * 12. / 1.e15 * ryyss    ! conversion molC/kt --> PgC/yr
             xfact2 = 1.e+3 * rno3 * 14. / 1.e12 * ryyss   ! conversion molC/l/s ----> TgN/m3/yr
+            xfact3 = 1.e+3 * rfact2r * rno3   ! conversion molC/l/kt ----> molN/m3/s
             cltxt='time-step   Alkalinity        Nitrate        Phosphorus         Silicate           Iron'
             IF( lwp ) WRITE(numnut,*)  TRIM(cltxt)
@@ -574,5 +574,5 @@
       IF( iom_use( "Sdenit" ) .OR.  ( ln_check_mass .AND. kt == nitend )  ) THEN
          zsdenittot   = glob_sum ( sdenit(:,:) * e1e2t(:,:) )
-         CALL iom_put( "Sdenit", sdenit(:,:) * zfact * tmask(:,:,1) )  ! Nitrate reduction in the sediments
+         CALL iom_put( "Sdenit", sdenit(:,:) * xfact3 * tmask(:,:,1) )  ! Nitrate reduction in the sediments
       ENDIF
 
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90	(revision 6440)
@@ -101,4 +101,6 @@
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hi         !: ???
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   excess     !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aphscale   !: 
+
 
    !!* Temperature dependancy of SMS terms
@@ -154,5 +156,6 @@
          &      ak23(jpi,jpj,jpk)    , aksp  (jpi,jpj,jpk) ,       &
          &      akw3(jpi,jpj,jpk)    , borat (jpi,jpj,jpk) ,       &
-         &      hi  (jpi,jpj,jpk)    , excess(jpi,jpj,jpk) ,     STAT=ierr(4) )
+         &      hi  (jpi,jpj,jpk)    , excess(jpi,jpj,jpk) ,       &
+         &      aphscale(jpi,jpj,jpk),                           STAT=ierr(4) )
          !
       !* Temperature dependancy of SMS terms
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/trcice_pisces.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/trcice_pisces.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/trcice_pisces.F90	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90	(revision 6440)
@@ -115,7 +115,8 @@
       po4r    =   1._wp / 122._wp
       o2nit   =  32._wp / 122._wp
-      rdenit  = 105._wp /  16._wp
+      o2ut    = 133._wp / 122._wp
+      rdenit  =  ( ( o2ut + o2nit ) * 0.80 - rno3 - rno3 * 0.60 ) / rno3
       rdenita =   3._wp /  5._wp
-      o2ut    = 133._wp / 122._wp
+
 
       ! Initialization of tracer concentration in case of  no restart 
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90	(revision 6440)
@@ -107,6 +107,6 @@
                
                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(:,:,:)
+               CALL trc_dta( kt, sf_trcdta(jl) )   ! read tracer data at nit000
+               ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:) * tmask(:,:,:) * rf_trfac(jl)
 
                SELECT CASE ( nn_zdmp_tr )
@@ -187,5 +187,4 @@
       INTEGER :: ji , jj, jk, jn, jl, jc                     ! dummy loop indicesa
       INTEGER :: isrow                                      ! local index
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta       ! 3D  workspace
 
       !!----------------------------------------------------------------------
@@ -278,16 +277,13 @@
          IF(lwp)  WRITE(numout,*)
          !
-         CALL wrk_alloc( jpi, jpj, jpk, ztrcdta )   ! Memory allocation
-         !
          DO jn = 1, jptra
             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(:,:,:)
+                CALL trc_dta( kt, sf_trcdta(jl) )   ! read tracer data at nit000
                 DO jc = 1, npncts
                    DO jk = 1, jpkm1
                       DO jj = nctsj1(jc), nctsj2(jc)
                          DO ji = nctsi1(jc), nctsi2(jc)
-                            trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk) * tmask(ji,jj,jk)
+                            trn(ji,jj,jk,jn) = sf_trcdta(jl)%fnow(ji,jj,jk) * tmask(ji,jj,jk) * rf_trfac(jl)
                             trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn)
                          ENDDO
@@ -297,5 +293,5 @@
              ENDIF
           ENDDO
-          CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta )
+          !
       ENDIF
       !
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90	(revision 6440)
@@ -56,5 +56,6 @@
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
       !!
-      INTEGER            :: jn
+      INTEGER            :: ji, jj, jk, jn
+      REAL(wp)           :: zdep
       CHARACTER (len=22) :: charout
       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd
@@ -66,5 +67,17 @@
 
       rldf = rldf_rat
-
+      !
+      r_fact_lap(:,:,:) = 1.
+      DO jk= 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( fsdept(ji,jj,jk) > 200. .AND. gphit(ji,jj) < 5. .AND. gphit(ji,jj) > -5. ) THEN
+                  zdep = MAX( fsdept(ji,jj,jk) - 1000., 0. ) / 1000.
+                  r_fact_lap(ji,jj,jk) = MAX( 1., rn_fact_lap * EXP( -zdep ) )
+               ENDIF
+            END DO
+         END DO
+      END DO
+      !
       IF( l_trdtrc )  THEN
          CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd )
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcnam_trp.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcnam_trp.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcnam_trp.F90	(revision 6440)
@@ -40,4 +40,5 @@
    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)
+   REAL(wp), PUBLIC ::   rn_fact_lap         !: Enhanced zonal diffusivity coefficent in the equatorial domain
 
    !                                        !!: ** Treatment of Negative concentrations ( nam_trcrad )
@@ -74,5 +75,7 @@
       NAMELIST/namtrc_ldf/ ln_trcldf_lap  ,     &
          &                 ln_trcldf_bilap, ln_trcldf_level,     &
-         &                 ln_trcldf_hor  , ln_trcldf_iso  , rn_ahtrc_0, rn_ahtrb_0
+         &                 ln_trcldf_hor  , ln_trcldf_iso  , rn_ahtrc_0, rn_ahtrb_0,   &
+         &                 rn_fact_lap
+
       NAMELIST/namtrc_zdf/ ln_trczdf_exp  , nn_trczdf_exp
       NAMELIST/namtrc_rad/ ln_trcrad
@@ -127,4 +130,5 @@
          WRITE(numout,*) '      diffusivity coefficient                                 rn_ahtrc_0 = ', rn_ahtrc_0
          WRITE(numout,*) '      background hor. diffusivity                             rn_ahtrb_0 = ', rn_ahtrb_0
+         WRITE(numout,*) '      enhanced zonal diffusivity                             rn_fact_lap = ', rn_fact_lap
       ENDIF
 
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90	(revision 6440)
@@ -102,4 +102,7 @@
       ENDIF
 
+#if defined key_agrif
+      CALL Agrif_trc                   ! AGRIF zoom boundaries
+#endif
       ! Update after tracer on domain lateral boundaries
       DO jn = 1, jptra
@@ -110,7 +113,4 @@
 #if defined key_bdy
 !!      CALL bdy_trc( kt )               ! BDY open boundaries
-#endif
-#if defined key_agrif
-      CALL Agrif_trc                   ! AGRIF zoom boundaries
 #endif
 
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90	(revision 6440)
@@ -170,4 +170,6 @@
             END DO
          ENDIF
+         !
+         CALL lbc_lnk( sbc_trc(:,:,jn), 'T', 1. )
          !                                       Concentration dilution effect on tracers due to evaporation & precipitation 
          DO jj = 2, jpj
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90	(revision 6440)
@@ -67,5 +67,4 @@
          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
@@ -78,4 +77,5 @@
                                 CALL trc_nxt( kstp )            ! tracer fields at next time step     
          IF( ln_trcrad )        CALL trc_rad( kstp )            ! Correct artificial negative concentrations
+         IF( ln_trcdmp_clo )    CALL trc_dmp_clo( kstp )        ! internal damping trends on closed seas only
 
 #if defined key_agrif
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90	(revision 6440)
@@ -116,4 +116,5 @@
    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_oce , ONLY :  r_fact_lap     =>  r_fact_lap        !: enhanced zonal diffusivity coefficient
 
    !* vertical diffusion *
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/trcdta.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/trcdta.F90	(revision 6440)
@@ -151,5 +151,5 @@
 
 
-   SUBROUTINE trc_dta( kt, sf_dta, zrf_trfac )
+   SUBROUTINE trc_dta( kt, sf_dta )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE trc_dta  ***
@@ -165,5 +165,4 @@
       INTEGER                     , INTENT(in   ) ::   kt     ! ocean time-step
       TYPE(FLD), DIMENSION(1)   , INTENT(inout) ::   sf_dta     ! array of information on the field to read
-      REAL(wp)                  , INTENT(in   ) ::   zrf_trfac  ! multiplication factor
       !
       INTEGER ::   ji, jj, jk, jl, jkk, ik    ! dummy loop indices
@@ -234,6 +233,4 @@
          ENDIF
          !
-         sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * zrf_trfac   !  multiplicative factor
-         !
          IF( lwp .AND. kt == nit000 ) THEN
                clndta = TRIM( sf_dta(1)%clvar ) 
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/trcini.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/trcini.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/trcini.F90	(revision 6440)
@@ -61,5 +61,4 @@
       INTEGER ::   jk, jn, jl    ! dummy loop indices
       CHARACTER (len=25) :: charout
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta   ! 4D  workspace
       !!---------------------------------------------------------------------
       !
@@ -121,12 +120,10 @@
         IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN  ! Initialisation of tracer from a file that may also be used for damping
             !
-            CALL wrk_alloc( jpi, jpj, jpk, ztrcdta )    ! Memory allocation
-            !
             DO jn = 1, jptra
                IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file
                   jl = n_trc_index(jn) 
-                  CALL trc_dta( nit000, sf_trcdta(jl),rf_trfac(jl) )   ! read tracer data at nit000
-                  ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:)
-                  trn(:,:,:,jn) = ztrcdta(:,:,:) * tmask(:,:,:)  
+                  CALL trc_dta( nit000, sf_trcdta(jl) )   ! read tracer data at nit000
+                  trn(:,:,:,jn) = sf_trcdta(jl)%fnow(:,:,:) * tmask(:,:,:) * rf_trfac(jl)
+                  !
                   IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN      !== deallocate data structure   ==!
                      !                                                    (data used only for initialisation)
@@ -138,5 +135,5 @@
                ENDIF
             ENDDO
-            CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta )
+            !
         ENDIF
         !
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/trcnam.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/trcnam.F90	(revision 6440)
@@ -397,3 +397,3 @@
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
-END MODULE  trcnam
+END MODULE trcnam
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/trcsms.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/trcsms.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/trcsms.F90	(revision 6440)
@@ -75,3 +75,3 @@
 
    !!======================================================================
-END MODULE  trcsms
+END MODULE trcsms
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/trcstp.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/NEMO/TOP_SRC/trcstp.F90	(revision 6440)
@@ -32,5 +32,5 @@
    REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE ::   qsr_arr ! save qsr during TOP time-step
    REAL(wp) :: rdt_sampl
-   INTEGER  :: nb_rec_per_days
+   INTEGER  :: nb_rec_per_day
    INTEGER  :: isecfst, iseclast
    LOGICAL  :: llnew
@@ -123,5 +123,5 @@
       !!               of diurnal cycle
       !!
-      !! ** Method  : store in TOP the qsr every hour ( or every time-step the latter 
+      !! ** Method  : store in TOP the qsr every hour ( or every time-step if the latter 
       !!              is greater than 1 hour ) and then, compute the  mean with 
       !!              a moving average over 24 hours. 
@@ -134,21 +134,29 @@
          IF( ln_cpl )  THEN  
             rdt_sampl = 86400. / ncpl_qsr_freq
-            nb_rec_per_days = ncpl_qsr_freq
+            nb_rec_per_day = ncpl_qsr_freq
          ELSE  
             rdt_sampl = MAX( 3600., rdt * nn_dttrc )
-            nb_rec_per_days = INT( 86400 / rdt_sampl )
+            nb_rec_per_day = INT( 86400 / rdt_sampl )
          ENDIF
          !
          IF( lwp ) THEN
             WRITE(numout,*) 
-            WRITE(numout,*) ' Sampling frequency dt = ', rdt_sampl, 's','   Number of sampling per day  nrec = ', nb_rec_per_days
+            WRITE(numout,*) ' Sampling frequency dt = ', rdt_sampl, 's','   Number of sampling per day  nrec = ', nb_rec_per_day
             WRITE(numout,*) 
          ENDIF
          !
-         ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_days ) )
-         DO jn = 1, nb_rec_per_days
-            qsr_arr(:,:,jn) = qsr(:,:)
+         !                                            !* Restart: read in restart file
+         IF( ln_rsttr .AND. iom_varid( numrtr, 'qsr_mean', ldstop = .FALSE. ) > 0 ) THEN 
+            IF(lwp) WRITE(numout,*) 'trc_qsr_mean:   qsr_mean read in the restart file'
+            CALL iom_get( numrtr, jpdom_autoglo, 'qsr_mean', qsr_mean )   !  A mean of qsr
+         ELSE                                         !* no restart: set from nit000 values
+            IF(lwp) WRITE(numout,*) 'trc_qsr_mean:   qsr_mean set to nit000 values'
+            qsr_mean(:,:) = qsr(:,:)
+         ENDIF
+         !
+         ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_day ) )
+         DO jn = 1, nb_rec_per_day
+             qsr_arr(:,:,jn) = qsr_mean(:,:)
          ENDDO
-         qsr_mean(:,:) = qsr(:,:)
          !
          isecfst  = nsec_year + nsec1jan000   !   number of seconds between Jan. 1st 00h of nit000 year and the middle of time step
@@ -163,11 +171,18 @@
              &                      ' time = ', (iseclast+rdt*nn_dttrc/2.)/3600.,'hours '
           isecfst = iseclast
-          DO jn = 1, nb_rec_per_days - 1
+          DO jn = 1, nb_rec_per_day - 1
              qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1)
           ENDDO
-          qsr_arr (:,:,nb_rec_per_days) = qsr(:,:)
-          qsr_mean(:,:                ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_days
-      ENDIF
-      !
+          qsr_arr (:,:,nb_rec_per_day) = qsr(:,:)
+          qsr_mean(:,:                ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_day
+      ENDIF
+      !
+      IF( lrst_trc ) THEN    !* Write the mean of qsr in restart file 
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'trc_mean_qsr : write qsr_mean in restart file  kt =', kt
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+         CALL iom_rstput( kt, nitrst, numrtw, 'qsr_mean', qsr_mean(:,:) )
+      ENDIF
+     !
    END SUBROUTINE trc_mean_qsr
 
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-athena-xios
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-athena-xios	(revision 6439)
+++ 	(revision )
@@ -1,80 +1,0 @@
-#!/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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-gfortran_athena_xios
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-gfortran_athena_xios	(revision 6439)
+++ 	(revision )
@@ -1,127 +1,0 @@
-#!/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"
-
-export MPIRUN="mpirun.lsf"
-export LANG=en_US
-export NLSPATH=/opt/ibmhpc/pecurrent/base/msg/%L/%N:$NLSPATH
-export MP_LABELIO=yes
-export MP_STDOUTMODE=unordered
-export MP_EUILIB=us
-export MP_INFOLEVEL=0
-export MP_EUIDEVELOP=min
-export MP_INSTANCES=1
-export MP_SHARED_MEMORY=yes
-export MP_EAGER_LIMIT_LOCAL=2000000000
-export MP_EUIDEVICE=sn_single
-export MP_BULK_MIN_MSG_SIZE=16384
-export MP_POLLING_INTERVAL=1000000
-export MP_DEVTYPE=ib
-export MP_EAGER_LIMIT=262144
-export MP_TASK_AFFINITY=core
-export MP_BINDPROC=yes
-export MP_DEBUG_CHECK_PARAM=no
-export MP_MSG_API=mpi
-export MP_USE_BULK_XFER=yes
-export MP_WAIT_MODE=poll
-export LDR_CNTRL=TEXTPSIZE=64K@STACKPSIZE=64K@DATAPSIZE=64K
-export LD_LIBRARY_PATH=/users/home/ans040/local/lib:${LD_LIBRARY_PATH}
-
-XIOS_SERVER_PATHNAME="/users/home/ans040/SOFTWARE/XIOS/trunk/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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ifort_MERCATOR_CLUSTER
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ifort_MERCATOR_CLUSTER	(revision 6439)
+++ 	(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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ifort_athena
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ifort_athena	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ifort_athena	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ifort_athena_xios
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ifort_athena_xios	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ifort_athena_xios	(revision 6440)
@@ -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 NETCDF/parallel-netcdf-1.3.1 HDF5/hdf5-1.8.11_parallel
+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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-openmpi_NAVITI_MERCATOR
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-openmpi_NAVITI_MERCATOR	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-openmpi_NAVITI_MERCATOR	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/SETTE/all_functions.sh
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/SETTE/all_functions.sh	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/SETTE/all_functions.sh	(revision 6440)
@@ -286,22 +286,30 @@
         echo "################" >> ${SETTE_DIR}/output.sette
 
+        inxml=$1
         VAR_NAME=$( grep "^.*<.*file_definition.*type.*=" ${EXE_DIR}/$1 | sed -e "s% *\!.*%%" )
         if [ ${#VAR_NAME} -eq 0 ]
         then
+# This may have failed because the job is using XIOS_2.0 conventions and the file descriptions have moved to file_def.xml
+# Check again in case this is the case
+          VAR_NAME=$( grep "^.*<.*file_definition.*type.*=" ${EXE_DIR}/file_def.xml | sed -e "s% *\!.*%%" )
+          inxml="file_def.xml"
+          if [ ${#VAR_NAME} -eq 0 ]
+          then
                 echo "doing \"set_xio_file_type $@\". "
                 echo "xml_tag: file_definition with variable: type is empty"
-                echo "confirm that an appropriate file_definition is in \"${EXE_DIR}/$1\" "
+                echo "confirm that an appropriate file_definition is in \"${EXE_DIR}/$1\" or file_def.xml"
                 echo "exit"
                 echo "error in executing script : set_xio_file_type $@" >> ${SETTE_DIR}/output.sette
                 echo "....." >> ${SETTE_DIR}/output.sette
                 exit 1
+          fi
         fi
         if [ $2 == "one_file" ] 
         then
-           sed -e "s:multiple_file:one_file:" ${EXE_DIR}/$1 > ${EXE_DIR}/$1.tmp
+           sed -e "s:multiple_file:one_file:" ${EXE_DIR}/$inxml > ${EXE_DIR}/$inxml.tmp
         else
-           sed -e "s:one_file:multiple_file:" ${EXE_DIR}/$1 > ${EXE_DIR}/$1.tmp
-        fi
-        mv ${EXE_DIR}/$1.tmp ${EXE_DIR}/$1
+           sed -e "s:one_file:multiple_file:" ${EXE_DIR}/$inxml > ${EXE_DIR}/$inxml.tmp
+        fi
+        mv ${EXE_DIR}/$inxml.tmp ${EXE_DIR}/$inxml
 
         echo "finished script : set_xio_file_type $@" >> ${SETTE_DIR}/output.sette
@@ -336,6 +344,11 @@
         if [ ${#VAR_NAME} -eq 0 ]
         then
+# This may have failed because the iodef file is using XIOS_2.0 syntax where "boolean" has reduced to "bool"
+# Check again in case this is the case
+          VAR_NAME=$( grep "^.*<.*variable id.*=.*using_server.*=.*bool" ${EXE_DIR}/$1 | sed -e "s% *\!.*%%" )
+           if [ ${#VAR_NAME} -eq 0 ]
+           then
                 echo "doing \"set_xio_using_server $@\". "
-                echo "xml_tag: "variable id=using_server" with variable: boolean is empty"
+                echo "xml_tag: "variable id=using_server" with either variable: boolean or bool is empty"
                 echo "confirm that an appropriate variable id is in \"${EXE_DIR}/$1\" "
                 echo "exit"
@@ -343,4 +356,5 @@
                 echo "....." >> ${SETTE_DIR}/output.sette
                 exit 1
+           fi
         fi
         if [ $2 == "false" ]
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/SETTE/prepare_exe_dir.sh
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/SETTE/prepare_exe_dir.sh	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/SETTE/prepare_exe_dir.sh	(revision 6440)
@@ -70,5 +70,5 @@
 export EXE_DIR=${CONFIG_DIR}/${NEW_CONF}/${TEST_NAME}
 
-cp -r ${CONFIG_DIR}/${NEW_CONF}/EXP00/* ${EXE_DIR}/.
-cp -r ${SETTE_DIR}/iodef_sette.xml ${EXE_DIR}/iodef.xml
+cp -rL ${CONFIG_DIR}/${NEW_CONF}/EXP00/* ${EXE_DIR}/.
+if [ ! -f ${EXE_DIR}/file_def.xml ]; then cp -r ${SETTE_DIR}/iodef_sette.xml ${EXE_DIR}/iodef.xml; fi
 cd ${EXE_DIR}
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/SETTE/prepare_job.sh
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/SETTE/prepare_job.sh	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/SETTE/prepare_job.sh	(revision 6440)
@@ -186,5 +186,5 @@
   #  if [ ${MPI_FLAG} == "no" ] ; then
 		case ${COMPILER} in 
-			X64_MOBILIS)
+			X64_MOBILIS*)
                                 NB_REM=$( echo $NB_PROC $NXIO_PROC | awk '{print ( $1 + $2 ) % 16}')
 		        	if [ ${NB_REM} == 0 ] ; then
@@ -280,5 +280,5 @@
                                 fi
                                 ;;
-                        ifort_MERCATOR_CLUSTER)
+                        openmpi_NAVITI_MERCATOR)
                                 echo NB_PROCS ${NB_PROC}
                                 echo NB_NODES ${NB_NODES}
@@ -289,12 +289,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 +324,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
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/SETTE/sette.sh
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/SETTE/sette.sh	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/SETTE/sette.sh	(revision 6440)
@@ -140,7 +140,8 @@
 # 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 13 14 15 16
 
 do
@@ -1237,8 +1238,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 +1255,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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/SETTE/sette_rpt
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/SETTE/sette_rpt	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/SETTE/sette_rpt	(revision 6440)
@@ -440,4 +440,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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/SETTE/sette_rpt.sh
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/SETTE/sette_rpt.sh	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/SETTE/sette_rpt.sh	(revision 6440)
@@ -0,0 +1,339 @@
+#!/bin/bash -f
+#
+# simple SETTE report generator.
+#
+# This version should be run in the SETTE directory. 
+# The machine name will be picked up from the sette.sh script but the location of the
+# validation directory needs to be set here (currently assumed to reside in the ../CONFIG directory)
+#
+#########################################################################################
+######################### Start of function definitions #################################
+##
+function resttest() { 
+#
+# Restartability checks. Expects LONG and SHORT run directories
+# Compares end of LONG stat files with equivalent entries from the SHORT stat files.
+#
+  vdir=$1
+  nam=$2
+  pass=$3
+  mach=$4
+#
+  if [ -d $vdir/$nam ]; then
+    dorv=`ls -1rt $vdir/$nam/$mach/ | tail -1l `
+    dorv=`echo $dorv | sed -e 's:.*/::'`
+    f1o=$vdir/$nam/$mach/$dorv/LONG/ocean.output
+    f1s=$vdir/$nam/$mach/$dorv/LONG/solver.stat
+    f1t=$vdir/$nam/$mach/$dorv/LONG/tracer.stat
+    f2o=$vdir/$nam/$mach/$dorv/SHORT/ocean.output
+    f2s=$vdir/$nam/$mach/$dorv/SHORT/solver.stat
+    f2t=$vdir/$nam/$mach/$dorv/SHORT/tracer.stat
+
+    if  [ ! -f $f1s ] &&  [ ! -f $f1t ] ; then 
+      printf "%-20s %s\n" $nam " incomplete test";
+      return; 
+    fi
+    if  [ ! -f $f2s ] &&  [ ! -f $f2t ] ; then 
+      printf "%-20s %s\n" $nam " incomplete test";
+      return; 
+    fi
+#
+    done_oce=0
+
+    if  [  -f $f1s ] && [  -f $f2s ]; then 
+      nl=(`wc -l $f2s`)
+      tail -${nl[0]} $f1s > f1.tmp$$
+      cmp -s f1.tmp$$ $f2s
+      if [ $? == 0 ]; then
+        if [ $pass == 0 ]; then 
+          printf "%-20s %s %s\n" $nam  " solver.stat restartability  passed : " $dorv
+        fi
+      else
+        printf "%-20s %s %s\n" $nam  " solver.stat restartability  FAILED : " $dorv 
+#
+# Offer view of differences on the second pass
+#
+        if [ $pass == 1 ]; then
+          echo "<return> to view solver.stat differences"
+          read y
+          sdiff f1.tmp$$ $f2s
+          echo "<return> to view ocean.output differences"
+          read y
+          sdiff $f1o $f2o | grep "|"
+          done_oce=1
+          echo "<return> to continue"
+          read y
+        fi
+      fi
+    fi
+#
+# Check tracer.stat files (if they exist)
+#
+    if  [  -f $f1t ] && [  -f $f2t ]; then
+      nl=(`wc -l $f2t`)
+      tail -${nl[0]} $f1t > f1.tmp$$
+      cmp -s f1.tmp$$ $f2t
+      if [ $? == 0 ]; then
+        if [ $pass == 0 ]; then 
+          printf "%-20s %s %s\n" $nam  " tracer.stat restartability  passed : " $dorv
+        fi
+      else
+        printf "%-20s %s %s\n" $nam  " tracer.stat restartability  FAILED : " $dorv 
+#
+# Offer view of differences on the second pass
+#
+        if [ $pass == 1 ]; then
+          echo "<return> to view tracer.stat differences"
+          read y
+          sdiff f1.tmp$$ $f2t
+#
+# Only offer ocean.output view if it has not been viewed previously
+#
+          if [ $done_oce == 0 ]; then
+            echo "<return> to view ocean.output differences"
+            read y
+            sdiff $f1o $f2o | grep "|"
+          fi
+          echo "<return> to continue"
+          read y
+        fi
+      fi
+    fi
+    rm f1.tmp$$
+  fi
+}
+
+function reprotest(){
+#
+# Reproducibility checks. Expects REPRO_N_M and REPRO_I_J run directories
+# Compares end of stat files from each
+#
+  vdir=$1
+  nam=$2
+  pass=$3
+  mach=$4
+#
+  if [ -d $vdir/$nam ]; then
+    dorv=`ls -1rt $vdir/$nam/$mach/ | tail -1l `
+    dorv=`echo $dorv | sed -e 's:.*/::'`
+    rep1=`ls -1rt $vdir/$nam/$mach/$dorv/ | tail -2l | head -1 `
+    rep2=`ls -1rt $vdir/$nam/$mach/$dorv/ | tail -1l`
+    f1o=$vdir/$nam/$mach/$dorv/$rep1/ocean.output
+    f1s=$vdir/$nam/$mach/$dorv/$rep1/solver.stat
+    f1t=$vdir/$nam/$mach/$dorv/$rep1/tracer.stat
+    f2o=$vdir/$nam/$mach/$dorv/$rep2/ocean.output
+    f2s=$vdir/$nam/$mach/$dorv/$rep2/solver.stat
+    f2t=$vdir/$nam/$mach/$dorv/$rep2/tracer.stat
+
+    if  [ ! -f $f1s ] && [ ! -f $f1t ] ; then 
+      printf "%-20s %s\n" $nam " incomplete test";
+      return; 
+    fi
+    if  [ ! -f $f2s ] && [ ! -f $f2t ] ; then 
+      printf "%-20s %s\n" $nam " incomplete test";
+      return; 
+    fi
+#
+    done_oce=0
+
+    if  [ -f $f1s ] && [ -f $f2s ] ; then
+      cmp -s $f1s $f2s
+      if [ $? == 0 ]; then
+        if [ $pass == 0 ]; then 
+          printf "%-20s %s %s\n" $nam  " solver.stat reproducibility passed : " $dorv
+        fi
+      else
+        printf "%-20s %s %s\n" $nam  " solver.stat reproducibility FAILED : " $dorv 
+#
+# Offer view of differences on the second pass
+#
+        if [ $pass == 1 ]; then
+          echo "<return> to view solver.stat differences"
+          read y
+          sdiff f1.tmp$$ $f2s
+          echo "<return> to view ocean.output differences"
+          read y
+          sdiff $f1o $f2o | grep "|"
+          done_oce=1
+          echo "<return> to continue"
+          read y
+        fi
+      fi
+    fi
+#
+# Check tracer.stat files (if they exist)
+#
+    if  [ -f $f1t ] && [ -f $f2t ] ; then
+      cmp -s $f1t $f2t
+      if [ $? == 0 ]; then
+        if [ $pass == 0 ]; then           printf "%-20s %s %s\n" $nam  " tracer.stat reproducibility passed : " $dorv
+        fi
+      else
+        printf "%-20s %s %s\n" $nam  " tracer.stat reproducibility  FAILED : " $dorv
+#
+# Offer view of differences on the second pass
+#
+        if [ $pass == 1 ]; then
+          echo "<return> to view tracer.stat differences"
+          read y
+          sdiff $f1t $f2t
+#
+# Only offer ocean.output view if it has not been viewed previously
+#
+          if [ $done_oce == 0 ]; then
+            echo "<return> to view ocean.output differences"
+            read y
+            sdiff $f1o $f2o | grep "|"
+          fi
+          echo "<return> to continue"
+          read y
+        fi
+      fi
+    fi
+  fi
+}
+
+function xiostest() { 
+#
+# XIOS functionality checks. Expects ATTACHED_MULTIPLE, ATTACHED_ONE, DETACHED_MULTIPLE and
+# DETACHED_ONE run directories.
+# Compares stat files from ATTACHED_MULTIPLE with equivalent entries from the others
+#
+  vdir=$1
+  nam=$2
+  pass=$3
+  mach=$4
+#
+  if [ -d $vdir/$nam ]; then
+    dorv=`ls -1rt $vdir/$nam/$mach/ | tail -1l `
+    dorv=`echo $dorv | sed -e 's:.*/::'`
+    f1o=$vdir/$nam/$mach/$dorv/ATTACHED_MULTIPLE/ocean.output
+    f1s=$vdir/$nam/$mach/$dorv/ATTACHED_MULTIPLE/solver.stat
+    f1t=$vdir/$nam/$mach/$dorv/ATTACHED_MULTIPLE/tracer.stat
+    if [ $pass == 0 ]; then printf "%-20s %s %s\n" $nam " checking against " "ATTACHED_MULTIPLE" ; fi
+    for OTHER in ATTACHED_ONE DETACHED_MULTIPLE DETACHED_ONE
+    do
+      f2o=$vdir/$nam/$mach/$dorv/$OTHER/ocean.output
+      f2s=$vdir/$nam/$mach/$dorv/$OTHER/solver.stat
+      f2t=$vdir/$nam/$mach/$dorv/$OTHER/tracer.stat
+
+      if  [ ! -f $f1s ] &&  [ ! -f $f1t ] ; then 
+        printf "%-20s %s %s\n" $nam " incomplete test " $OTHER;
+        return; 
+      fi
+      if  [ ! -f $f2s ] &&  [ ! -f $f2t ] ; then 
+        printf "%-20s %s %s\n" $nam " incomplete test " $OTHER;
+        return; 
+      fi
+#
+      done_oce=0
+
+      if  [  -f $f1s ] && [  -f $f2s ]; then 
+        nl=(`wc -l $f2s`)
+        tail -${nl[0]} $f1s > f1.tmp$$
+        cmp -s f1.tmp$$ $f2s
+        if [ $? == 0 ]; then
+          if [ $pass == 0 ]; then 
+            printf "%-20s %s %s %s\n" $nam  " solver.stat restartability  passed : " $dorv $OTHER
+          fi
+        else
+          printf "%-20s %s %s %s\n" $nam  " solver.stat restartability  FAILED : " $dorv  $OTHER
+#
+# Offer view of differences on the second pass
+#
+          if [ $pass == 1 ]; then
+            echo "<return> to view solver.stat differences"
+            read y
+            sdiff f1.tmp$$ $f2s
+            echo "<return> to view ocean.output differences"
+            read y
+            sdiff $f1o $f2o | grep "|"
+            done_oce=1
+            echo "<return> to continue"
+            read y
+          fi
+        fi
+      fi
+#
+# Check tracer.stat files (if they exist)
+#
+      if  [  -f $f1t ] && [  -f $f2t ]; then
+        nl=(`wc -l $f2t`)
+        tail -${nl[0]} $f1t > f1.tmp$$
+        cmp -s f1.tmp$$ $f2t
+        if [ $? == 0 ]; then
+          if [ $pass == 0 ]; then 
+            printf "%-20s %s %s %s\n" $nam  " tracer.stat restartability  passed : " $dorv $OTHER
+          fi
+        else
+          printf "%-20s %s %s %s\n" $nam  " tracer.stat restartability  FAILED : " $dorv  $OTHER
+#
+# Offer view of differences on the second pass
+#
+          if [ $pass == 1 ]; then
+            echo "<return> to view tracer.stat differences"
+            read y
+            sdiff f1.tmp$$ $f2t
+#
+# Only offer ocean.output view if it has not been viewed previously
+#
+            if [ $done_oce == 0 ]; then
+              echo "<return> to view ocean.output differences"
+              read y
+              sdiff $f1o $f2o | grep "|"
+            fi
+            echo "<return> to continue"
+            read y
+          fi
+        fi
+      fi
+      rm f1.tmp$$
+    done
+  fi
+}
+
+########################### END of function definitions #################################
+##                                                                                     ##
+##    Main script                                                                      ##
+##                                                                                     ##
+#########################################################################################
+#
+  mach1=`grep "COMPILER=" ./sette.sh | sed -e 's/COMPILER=//'`
+  mach2=`grep "COMPILER=" ./sette_xios.sh | sed -e 's/COMPILER=//'`
+  NEMO_VALID=`grep "NEMO_VALIDATION_DIR=" ./param.cfg | sed -e 's/NEMO_VALIDATION_DIR=//'`
+#
+  if [ ! -d $NEMO_VALID ]; then
+    echo "$NEMO_VALID validation directory not found"
+    exit
+  fi
+#
+# The script also needs the date or revision tag. Currently this is taken from the latest sub-directory found in each directory
+#  
+for pass in  0 1 
+do
+#
+ if [ $pass == 1 ]; then echo "---------------2nd pass------------------";fi
+#
+# Restartability test
+#
+ for restart_test in WGYRE_LONG WISOMIP_LONG WORCA2LIMPIS_LONG WORCA2OFFPIS_LONG WAMM12_LONG WORCA2LIM3_LONG WSAS_LONG WORCA2AGUL_LONG
+ do
+   resttest $NEMO_VALID $restart_test $pass $mach1
+ done
+#
+# sette_xios tests (allow for the possibility of a different compiler base)
+#
+ for xios_test in WGYRE_XIOS_LR WGYRE_XIOS_HR
+ do
+   xiostest $NEMO_VALID $xios_test $pass $mach2
+ done
+#
+# Reproducibility tests
+#
+ for repro_test in WGYRE_4 WISOMIP_4 WORCA2LIMPIS_16 WORCA2OFFPIS_16 WAMM12_32 WORCA2LIM3_16 WORCA2_LIM_OBS WSAS_32 WORCA2AGUL_1_2 WORCA2AGUL_16 WORCA2AGUL_2_2_NAG
+ do
+   reprotest $NEMO_VALID $repro_test $pass $mach1
+ done
+#
+done
+exit
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/COMPILE/Fmake_config.sh
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/COMPILE/Fmake_config.sh	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/COMPILE/Fmake_config.sh	(revision 6440)
@@ -65,4 +65,5 @@
 [ -f ${2}/EXP00/iodef.xml ] &&  \cp -R  ${2}/EXP00/iodef.xml ${1}/EXP00/.
 [ -f ${2}/EXP00/field_def.xml ] &&  \cp -R  ${2}/EXP00/field_def.xml ${1}/EXP00/.
+[ -f ${2}/EXP00/file_def.xml ] &&  \cp -R  ${2}/EXP00/file_def.xml ${1}/EXP00/.
 [ -f ${2}/EXP00/domain_def.xml ] &&  \cp -R  ${2}/EXP00/domain_def.xml ${1}/EXP00/.
 [ -f ${2}/EXP00/xmlio_server.def ] &&  \cp -R  ${2}/EXP00/xmlio_server.def ${1}/EXP00/.
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/COMPILE/Fprep_agrif.sh
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/COMPILE/Fprep_agrif.sh	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/COMPILE/Fprep_agrif.sh	(revision 6440)
@@ -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
+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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/COMPILE/agrifpp.sh
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/COMPILE/agrifpp.sh	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/COMPILE/agrifpp.sh	(revision 6440)
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/COMPILE/bld.cfg
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/COMPILE/bld.cfg	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/COMPILE/bld.cfg	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/COMPILE/bld_preproagr.cfg
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/COMPILE/bld_preproagr.cfg	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/COMPILE/bld_preproagr.cfg	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/COMPILE/conv.cfg
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/COMPILE/conv.cfg	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/COMPILE/conv.cfg	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/COMPILE/tools.txt
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/COMPILE/tools.txt	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/COMPILE/tools.txt	(revision 6440)
@@ -1,1 +1,1 @@
-REBUILD 
+SIREN 
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/DMP_TOOLS/src/zoom.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/DMP_TOOLS/src/zoom.F90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/DMP_TOOLS/src/zoom.F90	(revision 6440)
@@ -29,7 +29,4 @@
       NAMELIST/nam_zoom_dmp/lzoom_n,lzoom_e,lzoom_w,lzoom_s
       !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start( 'dtacof_zoom')
-      !
       
       ! Read namelist
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/MISCELLANEOUS/icb_pp.py
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/MISCELLANEOUS/icb_pp.py	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/MISCELLANEOUS/icb_pp.py	(revision 6440)
@@ -55,5 +55,5 @@
 if procnum < 1:
    print('Need some files to collate! procnum = ',procnum)
-   sys.exit()
+   sys.exit(11)
 
 icu = []
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/MPP_PREP/src/mpp_optimiz_zoom_nc.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/MPP_PREP/src/mpp_optimiz_zoom_nc.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/MPP_PREP/src/mpp_optimiz_zoom_nc.f90	(revision 6440)
@@ -258,10 +258,13 @@
                  ijlb=ijdom(jni2,jnj2)
               ENDIF
+
+              ! Check wet points over the entire domain to preserve the MPI communication stencil
               isurf=0
-              DO jj=1+jprecj,ippdj(jni2,jnj2)-jprecj
-                 DO  ji=1+jpreci,ippdi(jni2,jnj2)-jpreci
+              DO jj=1,ippdj(jni2,jnj2)
+                 DO  ji=1,ippdi(jni2,jnj2)
                     IF(zmask(ji+iilb-1,jj+ijlb-1).EQ.1.) isurf=isurf+1
                  END DO
               END DO
+
               IF(isurf.EQ.0) THEN
                  ivide=ivide+1
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/MPP_PREP/src/mppopt_showproc_nc.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/MPP_PREP/src/mppopt_showproc_nc.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/MPP_PREP/src/mppopt_showproc_nc.f90	(revision 6440)
@@ -289,11 +289,13 @@
                  ijlb=ijdom(jni2,jnj2)
               ENDIF
+
+              ! Check wet points over the entire domain to preserve the MPI communication stencil
               isurf=0
-
-              DO jj=1+jprecj,ippdj(jni2,jnj2)-jprecj
-                 DO  ji=1+jpreci,ippdi(jni2,jnj2)-jpreci
+              DO jj=1,ippdj(jni2,jnj2)
+                 DO  ji=1,ippdi(jni2,jnj2)
                     IF(zmask(ji+iilb-1,jj+ijlb-1).EQ.1.) isurf=isurf+1
                  END DO
               END DO
+
               IF(isurf.EQ.0) THEN
                  ivide=ivide+1
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/NESTING/agulhas
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/NESTING/agulhas	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/NESTING/agulhas	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/NESTING/src/agrif_connect_topo.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/NESTING/src/agrif_connect_topo.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/NESTING/src/agrif_connect_topo.f90	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/NESTING/src/agrif_partial_steps.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/NESTING/src/agrif_partial_steps.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/NESTING/src/agrif_partial_steps.f90	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/NESTING/src/agrif_types.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/NESTING/src/agrif_types.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/NESTING/src/agrif_types.f90	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/REBUILD_NEMO/icb_combrest.py
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/REBUILD_NEMO/icb_combrest.py	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/REBUILD_NEMO/icb_combrest.py	(revision 6440)
@@ -0,0 +1,273 @@
+import os
+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(11)
+
+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(12)
+ 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(13)
+else :
+  # Copy 2D variables across to output file from input file. This step avoids problems if rebuild_nemo 
+  # has created an "n" dimension in the prototype rebuilt file (ie. if there are icebergs on the zeroth 
+  # processor). 
+  try:
+    os.rename(pathout,pathout.replace('.nc','_WORK.nc'))
+  except OSError:
+    print 'Error: unable to move icebergs restart file: '+pathout
+    sys.exit(14)
+  #
+  try:
+    fi = Dataset(pathout.replace('.nc','_WORK.nc'), 'r')
+  except:
+    print 'Error: unable to open icebergs restart file: '+pathout.replace('.nc','_WORK.nc')
+    sys.exit(15)
+  fo = Dataset(pathout, 'w')
+  for dim in ['x','y','c']:
+    indim = fi.dimensions[dim]
+    fo.createDimension(dim, len(indim))
+  for var in ['calving','calving_hflx','stored_ice','stored_heat']:
+    invar = fi.variables[var]
+    fo.createVariable(var, invar.datatype, invar.dimensions)
+    fo.variables[var][:] = invar[:]
+    fo.variables[var].long_name = invar.long_name
+    fo.variables[var].units = invar.units
+    os.remove(pathout.replace('.nc','_WORK.nc'))
+#
+add_k = 1
+for d in fo.dimensions :
+  if d == 'n' :
+    print 'Error: dimension n already exists in output file'
+    sys.exit(16)
+  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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/REBUILD_NEMO/src/rebuild_nemo.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/REBUILD_NEMO/src/rebuild_nemo.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/REBUILD_NEMO/src/rebuild_nemo.f90	(revision 6440)
@@ -200,5 +200,5 @@
       WRITE(numerr,*) 'Attribute DOMAIN_number_total is : ', ndomain_file
       WRITE(numerr,*) 'Number of files specified in namelist is: ', ndomain
-      STOP
+      STOP 9
    ENDIF
   
@@ -268,5 +268,5 @@
       WRITE(numerr,*) 'Attribute DOMAIN_local_sizes is : ', local_sizes
       WRITE(numerr,*) 'Dimensions to be rebuilt are of size : ', outdimlens(rebuild_dims(1)), outdimlens(rebuild_dims(2)) 
-      STOP
+      STOP 9
    ENDIF
 
@@ -384,16 +384,21 @@
             SELECT CASE( xtype )
                CASE( NF90_BYTE )
+                  globaldata_0d_i1 = 0
                   CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_i1 ) )
                CASE( NF90_SHORT )
+                  globaldata_0d_i2 = 0
                   CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_i2 ) )
                CASE( NF90_INT )
+                  globaldata_0d_i4 = 0
                   CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_i4 ) )
                CASE( NF90_FLOAT )
+                  globaldata_0d_sp = 0.
                   CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_sp ) )
                CASE( NF90_DOUBLE )
+                  globaldata_0d_dp = 0.
                   CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_dp ) )
                CASE DEFAULT
                   WRITE(numerr,*) 'Unknown nf90 type: ', xtype
-                  STOP
+                  STOP 9
             END SELECT
 
@@ -403,20 +408,25 @@
                CASE( NF90_BYTE )
                   ALLOCATE(globaldata_1d_i1(indimlens(dimids(1))))
+                  globaldata_1d_i1(:) = 0
                   CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_i1 ) )
                CASE( NF90_SHORT )
                   ALLOCATE(globaldata_1d_i2(indimlens(dimids(1))))
+                  globaldata_1d_i2(:) = 0
                   CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_i2 ) )
                CASE( NF90_INT )
                   ALLOCATE(globaldata_1d_i4(indimlens(dimids(1))))
+                  globaldata_1d_i4(:) = 0
                   CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_i4 ) )
                CASE( NF90_FLOAT )
                   ALLOCATE(globaldata_1d_sp(indimlens(dimids(1))))
+                  globaldata_1d_sp(:) = 0.
                   CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_sp ) )
                CASE( NF90_DOUBLE )
                   ALLOCATE(globaldata_1d_dp(indimlens(dimids(1))))
+                  globaldata_1d_dp(:) = 0.
                   CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_dp ) )
                CASE DEFAULT
                   WRITE(numerr,*) 'Unknown nf90 type: ', xtype
-                  STOP
+                  STOP 9
             END SELECT
 
@@ -426,20 +436,25 @@
                CASE( NF90_BYTE )
                   ALLOCATE(globaldata_2d_i1(indimlens(dimids(1)),indimlens(dimids(2))))
+                  globaldata_2d_i1(:,:) = 0
                   CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_i1 ) )
                CASE( NF90_SHORT )
                   ALLOCATE(globaldata_2d_i2(indimlens(dimids(1)),indimlens(dimids(2))))
+                  globaldata_2d_i2(:,:) = 0
                   CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_i2 ) )
                CASE( NF90_INT )
                   ALLOCATE(globaldata_2d_i4(indimlens(dimids(1)),indimlens(dimids(2))))
+                  globaldata_2d_i4(:,:) = 0
                   CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_i4 ) )
                CASE( NF90_FLOAT )
                   ALLOCATE(globaldata_2d_sp(indimlens(dimids(1)),indimlens(dimids(2))))
+                  globaldata_2d_sp(:,:) = 0.
                   CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_sp ) )
                CASE( NF90_DOUBLE )
                   ALLOCATE(globaldata_2d_dp(indimlens(dimids(1)),indimlens(dimids(2))))
+                  globaldata_2d_dp(:,:) = 0.
                   CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_dp ) )
                CASE DEFAULT
                   WRITE(numerr,*) 'Unknown nf90 type: ', xtype
-                  STOP
+                  STOP 9
             END SELECT
 
@@ -450,24 +465,29 @@
                   ALLOCATE(globaldata_3d_i1(indimlens(dimids(1)),indimlens(dimids(2)),       &
                      &                      indimlens(dimids(3))))
+                  globaldata_3d_i1(:,:,:) = 0
                   CALL check_nf90( nf90_get_var( ncid, jv, globaldata_3d_i1 ) )
                CASE( NF90_SHORT )
                   ALLOCATE(globaldata_3d_i2(indimlens(dimids(1)),indimlens(dimids(2)),       &
                      &                      indimlens(dimids(3))))
+                  globaldata_3d_i2(:,:,:) = 0
                   CALL check_nf90( nf90_get_var( ncid, jv, globaldata_3d_i2 ) )
                CASE( NF90_INT )
                   ALLOCATE(globaldata_3d_i4(indimlens(dimids(1)),indimlens(dimids(2)),       &
                      &                      indimlens(dimids(3))))
+                  globaldata_3d_i4(:,:,:) = 0
                   CALL check_nf90( nf90_get_var( ncid, jv, globaldata_3d_i4 ) )
                CASE( NF90_FLOAT )
                   ALLOCATE(globaldata_3d_sp(indimlens(dimids(1)),indimlens(dimids(2)),       &
                      &                      indimlens(dimids(3))))
+                  globaldata_3d_sp(:,:,:) = 0.
                   CALL check_nf90( nf90_get_var( ncid, jv, globaldata_3d_sp ) )
                CASE( NF90_DOUBLE )
                   ALLOCATE(globaldata_3d_dp(indimlens(dimids(1)),indimlens(dimids(2)),       &
                      &                      indimlens(dimids(3))))
+                  globaldata_3d_dp(:,:,:) = 0.
                   CALL check_nf90( nf90_get_var( ncid, jv, globaldata_3d_dp ) )
                CASE DEFAULT
                   WRITE(numerr,*) 'Unknown nf90 type: ', xtype
-                  STOP
+                  STOP 9
             END SELECT
 
@@ -478,24 +498,29 @@
                   ALLOCATE(globaldata_4d_i1(indimlens(dimids(1)),indimlens(dimids(2)),       &
                      &                      indimlens(dimids(3)),ntchunk))
+                  globaldata_4d_i1(:,:,:,:) = 0
                   CALL check_nf90( nf90_get_var( ncid, jv, globaldata_4d_i1, start=(/1,1,1,nt/) ) )
                CASE( NF90_SHORT )
                   ALLOCATE(globaldata_4d_i2(indimlens(dimids(1)),indimlens(dimids(2)),       &
                      &                      indimlens(dimids(3)),ntchunk))
+                  globaldata_4d_i2(:,:,:,:) = 0
                   CALL check_nf90( nf90_get_var( ncid, jv, globaldata_4d_i2, start=(/1,1,1,nt/) ) )
                CASE( NF90_INT )
                   ALLOCATE(globaldata_4d_i4(indimlens(dimids(1)),indimlens(dimids(2)),       &
                      &                      indimlens(dimids(3)),ntchunk))
+                  globaldata_4d_i4(:,:,:,:) = 0
                   CALL check_nf90( nf90_get_var( ncid, jv, globaldata_4d_i4, start=(/1,1,1,nt/) ) )
                CASE( NF90_FLOAT )
                   ALLOCATE(globaldata_4d_sp(indimlens(dimids(1)),indimlens(dimids(2)),       &
                      &                      indimlens(dimids(3)),ntchunk))
+                  globaldata_4d_sp(:,:,:,:) = 0.
                   CALL check_nf90( nf90_get_var( ncid, jv, globaldata_4d_sp, start=(/1,1,1,nt/) ) )
                CASE( NF90_DOUBLE )
                   ALLOCATE(globaldata_4d_dp(indimlens(dimids(1)),indimlens(dimids(2)),       &
                      &                      indimlens(dimids(3)),ntchunk))
+                  globaldata_4d_dp(:,:,:,:) = 0.
                   CALL check_nf90( nf90_get_var( ncid, jv, globaldata_4d_dp, start=(/1,1,1,nt/) ) )
                CASE DEFAULT
                   WRITE(numerr,*) 'Unknown nf90 type: ', xtype
-                  STOP
+                  STOP 9
             END SELECT
 
@@ -517,15 +542,20 @@
                CASE( NF90_BYTE )
                   ALLOCATE(globaldata_1d_i1(outdimlens(dimids(1))))
+                  globaldata_1d_i1(:) = 0
                CASE( NF90_SHORT )
                   ALLOCATE(globaldata_1d_i2(outdimlens(dimids(1))))
+                  globaldata_1d_i2(:) = 0
                CASE( NF90_INT )
                   ALLOCATE(globaldata_1d_i4(outdimlens(dimids(1))))
+                  globaldata_1d_i4(:) = 0
                CASE( NF90_FLOAT )
                   ALLOCATE(globaldata_1d_sp(outdimlens(dimids(1))))
+                  globaldata_1d_sp(:) = 0.
                CASE( NF90_DOUBLE )
                   ALLOCATE(globaldata_1d_dp(outdimlens(dimids(1))))
+                  globaldata_1d_dp(:) = 0.
                CASE DEFAULT
                   WRITE(numerr,*) 'Unknown nf90 type: ', xtype
-                  STOP
+                  STOP 9
             END SELECT
 
@@ -535,15 +565,20 @@
                CASE( NF90_BYTE )
                   ALLOCATE(globaldata_2d_i1(outdimlens(dimids(1)),outdimlens(dimids(2))))
+                  globaldata_2d_i1(:,:) = 0
                CASE( NF90_SHORT )
                   ALLOCATE(globaldata_2d_i2(outdimlens(dimids(1)),outdimlens(dimids(2))))
+                  globaldata_2d_i2(:,:) = 0
                CASE( NF90_INT )
                   ALLOCATE(globaldata_2d_i4(outdimlens(dimids(1)),outdimlens(dimids(2))))
+                  globaldata_2d_i4(:,:) = 0
                CASE( NF90_FLOAT )
                   ALLOCATE(globaldata_2d_sp(outdimlens(dimids(1)),outdimlens(dimids(2))))
+                  globaldata_2d_sp(:,:) = 0.
                CASE( NF90_DOUBLE )
                   ALLOCATE(globaldata_2d_dp(outdimlens(dimids(1)),outdimlens(dimids(2))))
+                  globaldata_2d_dp(:,:) = 0.
                CASE DEFAULT
                   WRITE(numerr,*) 'Unknown nf90 type: ', xtype
-                  STOP
+                  STOP 9
             END SELECT
 
@@ -554,19 +589,24 @@
                   ALLOCATE(globaldata_3d_i1(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
                      &                      outdimlens(dimids(3))))
+                  globaldata_3d_i1(:,:,:) = 0
                CASE( NF90_SHORT )
                   ALLOCATE(globaldata_3d_i2(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
                      &                      outdimlens(dimids(3))))
+                  globaldata_3d_i2(:,:,:) = 0
                CASE( NF90_INT )
                   ALLOCATE(globaldata_3d_i4(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
                      &                      outdimlens(dimids(3))))
+                  globaldata_3d_i4(:,:,:) = 0
                CASE( NF90_FLOAT )
                   ALLOCATE(globaldata_3d_sp(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
                      &                      outdimlens(dimids(3))))
+                  globaldata_3d_sp(:,:,:) = 0.
                CASE( NF90_DOUBLE )
                   ALLOCATE(globaldata_3d_dp(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
                      &                      outdimlens(dimids(3))))
+                  globaldata_3d_dp(:,:,:) = 0.
                CASE DEFAULT
                   WRITE(numerr,*) 'Unknown nf90 type: ', xtype
-                  STOP
+                  STOP 9
             END SELECT
 
@@ -577,23 +617,28 @@
                   ALLOCATE(globaldata_4d_i1(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
                      &                      outdimlens(dimids(3)),ntchunk))
+                   globaldata_4d_i1(:,:,:,:) = 0
                CASE( NF90_SHORT )
                   ALLOCATE(globaldata_4d_i2(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
                      &                      outdimlens(dimids(3)),ntchunk))
+                  globaldata_4d_i2(:,:,:,:) = 0
                CASE( NF90_INT )
                   ALLOCATE(globaldata_4d_i4(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
                      &                      outdimlens(dimids(3)),ntchunk))
+                  globaldata_4d_i4(:,:,:,:) = 0
                CASE( NF90_FLOAT )
                   ALLOCATE(globaldata_4d_sp(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
                      &                      outdimlens(dimids(3)),ntchunk))
+                  globaldata_4d_sp(:,:,:,:) = 0.
                CASE( NF90_DOUBLE )
                   ALLOCATE(globaldata_4d_dp(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
                      &                      outdimlens(dimids(3)),ntchunk))
+                  globaldata_4d_dp(:,:,:,:) = 0.
                CASE DEFAULT
                   WRITE(numerr,*) 'Unknown nf90 type: ', xtype
-                  STOP
+                  STOP 9
             END SELECT
          ELSE
             WRITE(numerr,*) 'ERROR! : A netcdf variable has more than 4 dimensions which is not taken into account'
-            STOP
+            STOP 9
          ENDIF
 
@@ -967,5 +1012,5 @@
             IF( nthreads == 1 .AND. istop /= nf90_noerr )  THEN
                WRITE(numerr,*) '*** NEMO rebuild failed! ***'
-               STOP
+               STOP 9
             ENDIF
         
@@ -976,5 +1021,5 @@
          IF( istop /= nf90_noerr )  THEN
             WRITE(numerr,*) '*** NEMO rebuild failed! ***'
-            STOP
+            STOP 9
          ENDIF
 
@@ -1050,5 +1095,5 @@
             CASE DEFAULT   
                WRITE(numerr,*) 'Unknown nf90 type: ', xtype
-               STOP
+               STOP 9
          END SELECT     
                       
@@ -1073,5 +1118,5 @@
             CASE DEFAULT   
                WRITE(numerr,*) 'Unknown nf90 type: ', xtype
-               STOP
+               STOP 9
          END SELECT     
     
@@ -1096,5 +1141,5 @@
             CASE DEFAULT   
                WRITE(numerr,*) 'Unknown nf90 type: ', xtype
-               STOP
+               STOP 9
          END SELECT     
     
@@ -1146,5 +1191,5 @@
             WRITE(numerr,*) "*** NEMO rebuild failed ***"
             WRITE(numerr,*)
-            STOP
+            STOP 9
          ENDIF
       ENDIF
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/cfg/dummy.cfg
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/cfg/dummy.cfg	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/cfg/dummy.cfg	(revision 6440)
@@ -0,0 +1,5 @@
+&namdum
+   cn_dumvar=""
+   cn_dumdim=""
+   cn_dumatt="history"
+/
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg	(revision 6440)
@@ -1,73 +1,159 @@
-# 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            | unitless       | X    |   |                 |                                       | projection_x_coordinate               
+Y            | unitless       | Y    |   |                 |                                       | projection_y_coordinate               
+Z            | unitless       | Z    |   |                 |                                       | projection_z_coordinate               
+T            | unitless       | T    |   |                 |                                       | projection_t_coordinate               
+nav_lon      | degrees_east   | XY   | T | cubic           | Longitude                             | longitude                                   
+nav_lat      | degrees_north  | XY   | T | cubic           | Latitude                              | latitude                         
+nav_lev      | model_levels   | Z    | T | cubic           | Model levels                          |                                  
+deptht       | m              | Z    | T |                 | Vertical T levels                     | depth                            
+time_counter |                | T    |   |                 | Time axis                             | time                             
+Bathymetry   | m              | XY   | T | cubic           | Bathymetry                            | bathymetry                       
+votemper     | degree_Celsius | XYZT | T | cubic           | Temperature                           | sea_water_potential_temperature  
+vozocrtx     | m s-1          | XYZT | U | cubic           | Zonal velocity                        |                                  
+vomecrty     | m s-1          | XYZT | V | cubic           | Meridional velocity                   |                                  
+vosaline     | PSU            | XYZT | T | cubic           | Salinity                              | sea_water_salinity               
+sossheig     | m              | XYT  | T | cubic           | Sea Surface Height                    | sea_surface_height               
+sotemper     | m              | XYT  | T | cubic           |                                       |                                  
+sossheig     | m              | XYT  | T | cubic           |                                       |                                  
+glamt        | degrees_east   | XY   | T | cubic           | Longitude_T                           |                                  
+glamu        | degrees_east   | XY   | U | cubic           | Longitude_U                           |                                   
+glamv        | degrees_east   | XY   | V | cubic           | Longitude_V                           |                                  
+glamf        | degrees_east   | XY   | F | cubic           | Longitude_F                           |                                  
+gphit        | degrees_north  | XY   | T | cubic           | Latitude_T                            |                                  
+gphiu        | degrees_north  | XY   | U | cubic           | Latitude_U                            |                                  
+gphiv        | degrees_north  | XY   | V | cubic           | Latitude_V                            |                                  
+gphif        | degrees_north  | XY   | F | cubic           | Latitude_F                            |                                  
+e1t          | m              | XY   | T | cubic/rhoi      |                                       |                                  
+e1u          | m              | XY   | U | cubic/rhoi      |                                       |                                  
+e1v          | m              | XY   | V | cubic/rhoi      |                                       |                                  
+e1f          | m              | XY   | F | cubic/rhoi      |                                       |                                  
+e2t          | m              | XY   | T | cubic/rhoj      |                                       |                                  
+e2u          | m              | XY   | U | cubic/rhoj      |                                       |                                  
+e2v          | m              | XY   | V | cubic/rhoj      |                                       |                                  
+e2f          | m              | XY   | F | cubic/rhoj      |                                       |                                  
+tmask        |                | XYZ  | T | nearest         |                                       |                                  
+umask        |                | XYZ  | U | nearest         |                                       |                                  
+vmask        |                | XYZ  | V | nearest         |                                       |                                  
+fmask        |                | XYZ  | F | nearest         |                                       |                                  
+weight       |                | XY   | T |                 |                                       |                                  
+kt           |                |      |   |                 |                                       |                                  
+ndastp       |                |      |   |                 |                                       |                                  
+adatrj       |                |      |   |                 |                                       |                                  
+kt           |                |      |   |                 |                                       |                                  
+rdt          |                |      |   |                 |                                       |                                  
+rdttra1      |                |      |   |                 |                                       |                                  
+utau_b       |                | XY   | U |                 |                                       |surface_downward_eastward_stress  
+vtau_b       |                | XY   | V |                 |                                       |surface_downward_northward_stress 
+qns_b        |                | XY   | T |                 |                                       |                                  
+emp_b        |                | XY   | T |                 |                                       |                                  
+sfx_b        |                | XY   | T |                 |                                       |                                  
+en           |                | XYZ  | T |                 |                                       |                                  
+avt          |                | XYZ  | T |                 | vertical eddy diffusivity             |                                  
+avm          |                | XYZ  | T |                 | vertical eddy viscosity               |                                  
+avmu         |                | XYZ  | T |                 |                                       |                                  
+avmv         |                | XYZ  | T |                 |                                       |                                  
+dissl        |                | XYZ  | T |                 |                                       |                                  
+sbc_hc_b     |                | XY   | T |                 |                                       |                                  
+sbc_sc_b     |                | XY   | T |                 |                                       |                                  
+gcx          |                | XY   | T |                 |                                       |                                  
+gcxb         |                | XY   | T |                 |                                       |                                  
+ub           |                | XYZ  | U |                 |                                       |                                  
+vb           |                | XYZ  | V |                 |                                       |                                  
+tb           |                | XYZ  | T |                 |                                       |                                  
+sb           |                | XYZ  | T |                 |                                       |                                  
+rotb         |                | XYZ  | T |                 |                                       |                                  
+hdivb        |                | XYZ  | T |                 |                                       |                                  
+sshb         |                | XY   | T |                 |                                       |                                  
+un           |                | XYZ  | U |                 |                                       |                                  
+vn           |                | XYZ  | V |                 |                                       |                                  
+tn           |                | XYZ  | T |                 |                                       |                                  
+sn           |                | XYZ  | T |                 |                                       |                                  
+rotn         |                | XYZ  | T |                 |                                       |                                  
+hdivn        |                | XYZ  | T |                 |                                       |                                  
+sshn         |                | XYT  | T |                 |                                       |                                  
+rhop         |                | XYZ  | T |                 |                                       |                                  
+dic          |                | XYZT | T |                 | Dissolved Inorganic Carbon            | mole_concentration_of_dissolved_inorganic_caron_in_sea_water
+alkalini     |                | XYZT | T |                 | Total Alkalinity                      | sea_water_alkalinity_expressed_as_mole_equivalent
+o2           |                | XYZT | T |                 | Dissolved Oxygen                      | mole_concentration_of_dissolved_molecular_oxygen_in_sea_water
+caco3        |                | XYZT | T |                 | Calcite                               |                                  
+po4          |                | XYZT | T |                 | Phosphate                             | mole_concentration_of_phosphate_in_sea_water
+poc          |                | XYZT | T |                 | Small Particulate Organic Carbon      |                                  
+si           |                | XYZT | T |                 | Dissolved Silicate                    | mole_concentration_of_silicate_in_sea_water
+phy          |                | XYZT | T |                 | Nanophytoplankton                     |                                  
+zoo          |                | XYZT | T |                 | Microzooplankton                      | mole_concentration_of_microzooplankton_expressed_as_carbon_in_sea_water
+doc          |                | XYZT | T |                 | Dissolved Organic Carbon              |                                  
+phy2         |                | XYZT | T |                 | Diatoms                               |                                  
+zoo2         |                | XYZT | T |                 | Mesozooplankton                       | mole_concentration_of_mesozooplankton_expressed_as_carbon_in_sea_water
+gsi          |                | XYZT | T |                 | Sinking biogenic Silica               |                                  
+fer          |                | XYZT | T |                 | Dissolved Iron                        | mole_concentration_of_dissolved_iron_in_sea_water
+bfe          |                | XYZT | T |                 | Iron in the big particles             |                                  
+goc          |                | XYZT | T |                 | Big Particulate Organic Carbon        |                                  
+sfe          |                | XYZT | T |                 | Iron in the small particles           |                                  
+dfe          |                | XYZT | T |                 | Iron content of the Diatoms           |                                  
+dsi          |                | XYZT | T |                 | Silicon content of the Diatoms        |                                  
+nfe          |                | XYZT | T |                 | Iron content of the Nanophytoplankton |                                  
+nchl         |                | XYZT | T |                 | Chlorophyll of the Nanophytoplankton  |                                  
+dchl         |                | XYZT | T |                 | Chlorophyll of the Diatoms            |                                  
+no3          |                | XYZT | T |                 | Nitrate                               | mole_concentration_of_nitrate_in_sea_water
+nh4          |                | XYZT | T |                 | Ammonium                              | mole_concentration_of_ammonium_in_sea_water
+ppd          |                | XYZT | T |                 |                                       |                                  
+ppn          |                | XYZT | T |                 |                                       |                                  
+ph           |                | XYZT | T |                 |                                       |                                  
+cflx         |                | XYZT | T |                 |                                       |                                  
+oflx         |                | XYZT | T |                 |                                       |                                  
+kg           |                | XYZT | T |                 |                                       |                                  
+dpco2        |                | XYZT | T |                 |                                       |                                  
+heup         |                | XYZT | T |                 |                                       |                                  
+kz           |                | XYZT | T |                 |                                       |                                  
+irondep      |                | XYZT | T |                 |                                       |                                  
+kt_ice       |                |      |   |                 |                                       |                                  
+hicif        |                |      |   |                 |                                       |                                  
+hsnif        |                |      |   |                 |                                       |                                  
+frld         |                |      |   |                 |                                       |                                  
+sist         |                |      |   |                 |                                       |                                  
+tbif1        |                |      |   |                 |                                       |                                  
+tbif2        |                |      |   |                 |                                       |                                  
+tbif3        |                |      |   |                 |                                       |                                  
+ui_ice       |                |      |   |                 |                                       |                                  
+vi_ice       |                |      |   |                 |                                       |                                  
+qstoif       |                |      |   |                 |                                       |                                  
+fsbbq        |                |      |   |                 |                                       |                                  
+stress1_i    |                |      |   |                 |                                       |                                  
+stress2_i    |                |      |   |                 |                                       |                                  
+stress12_i   |                |      |   |                 |                                       |                                  
+sxice        |                |      |   |                 |                                       |                                  
+syice        |                |      |   |                 |                                       |                                  
+sxxice       |                |      |   |                 |                                       |                                  
+syyice       |                |      |   |                 |                                       |                                  
+sxyice       |                |      |   |                 |                                       |                                  
+sxsn         |                |      |   |                 |                                       |                                  
+sysn         |                |      |   |                 |                                       |                                  
+sxxsn        |                |      |   |                 |                                       |                                  
+syysn        |                |      |   |                 |                                       |                                  
+sxysn        |                |      |   |                 |                                       |                                  
+sxa          |                |      |   |                 |                                       |                                  
+sya          |                |      |   |                 |                                       |                                  
+sxxa         |                |      |   |                 |                                       |                                  
+syya         |                |      |   |                 |                                       |                                  
+sxya         |                |      |   |                 |                                       |                                  
+sxc0         |                |      |   |                 |                                       |                                  
+syc0         |                |      |   |                 |                                       |                                  
+sxxc0        |                |      |   |                 |                                       |                                  
+syyc0        |                |      |   |                 |                                       |                                  
+sxyc0        |                |      |   |                 |                                       |                                  
+sxc1         |                |      |   |                 |                                       |                                  
+syc1         |                |      |   |                 |                                       |                                  
+sxxc1        |                |      |   |                 |                                       |                                  
+syyc1        |                |      |   |                 |                                       |                                  
+sxyc1        |                |      |   |                 |                                       |                                  
+sxc2         |                |      |   |                 |                                       |                                  
+syc2         |                |      |   |                 |                                       |                                  
+sxxc2        |                |      |   |                 |                                       |                                  
+syyc2        |                |      |   |                 |                                       |                                  
+sxyc2        |                |      |   |                 |                                       |                                  
+sxst         |                |      |   |                 |                                       |                                  
+syst         |                |      |   |                 |                                       |                                  
+sxxst        |                |      |   |                 |                                       |                                  
+syyst        |                |      |   |                 |                                       |                                  
+sxyst        |                |      |   |                 |                                       |                                  
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/Doxyfile
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/Doxyfile	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/Doxyfile	(revision 6440)
@@ -45,5 +45,5 @@
 # quick idea about the purpose of the project. Keep the description short.
 
-PROJECT_BRIEF          = "System and Interface for oceanic RElocable Nesting"
+PROJECT_BRIEF          = "System and Interface for oceanic RElocatable Nesting"
 
 # With the PROJECT_LOGO tag one can specify an logo or icon that is included in
@@ -2069,5 +2069,5 @@
 # The default value is: NO.
 
-HAVE_DOT               = YES
+HAVE_DOT               = NO
 
 # The DOT_NUM_THREADS specifies the number of dot invocations doxygen is allowed
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/attribute.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/attribute.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/attribute.f90	(revision 6440)
@@ -81,5 +81,8 @@
 ! REVISION HISTORY:
 !> @date November, 2013 - Initial Version
-!> @date November, 2014 - Fix memory leaks bug
+!> @date November, 2014 
+!> - Fix memory leaks bug
+!> @date September, 2015
+!> - manage useless (dummy) attributes
 !
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -97,4 +100,6 @@
    PUBLIC :: TATT       !< attribute structure
 
+   PRIVATE :: cm_dumatt !< dummy attribute array
+
    ! function and subroutine
    PUBLIC :: att_init       !< initialize attribute structure
@@ -104,4 +109,6 @@
    PUBLIC :: att_get_index  !< get attribute index, in an array of attribute structure
    PUBLIC :: att_get_id     !< get attribute id, read from file
+   PUBLIC :: att_get_dummy  !< fill dummy attribute array
+   PUBLIC :: att_is_dummy   !< check if attribute is defined as dummy attribute
 
    PRIVATE :: att__clean_unit ! clean attribute strcuture
@@ -130,10 +137,12 @@
       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
 
+   CHARACTER(LEN=lc), DIMENSION(ip_maxdum), SAVE :: cm_dumatt !< dummy attribute
+
    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 +190,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 +243,5 @@
 
       ! local variable
-      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_value
+      REAL(dp)         , DIMENSION(:), ALLOCATABLE :: dl_value
       !----------------------------------------------------------------
 
@@ -300,6 +309,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 +365,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 +378,5 @@
    !>
    !> @author J.Paul
-   !> @dtae November, 2013 - Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_name   attribute name
@@ -1068,5 +1078,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 +1125,5 @@
 
             CASE(NF90_CHAR)
+
                cl_value=td_att%c_value
 
@@ -1247,4 +1259,98 @@
 
    END SUBROUTINE att__clean_arr
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill dummy attribute array
+   !
+   !> @author J.Paul
+   !> @date September, 2015 - Initial Version
+   !> @date Marsh, 2016
+   !> - close file (bugfix)
+   !
+   !> @param[in] cd_dummy dummy configuration file
+   !-------------------------------------------------------------------
+   SUBROUTINE att_get_dummy( cd_dummy )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_dummy
+
+      ! local variable
+      INTEGER(i4)   :: il_fileid
+      INTEGER(i4)   :: il_status
+
+      LOGICAL       :: ll_exist
+
+      ! loop indices
+      ! namelist
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumvar
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumdim
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumatt
+
+      !----------------------------------------------------------------
+      NAMELIST /namdum/ &   !< dummy namelist
+      &  cn_dumvar, &       !< variable  name
+      &  cn_dumdim, &       !< dimension name
+      &  cn_dumatt          !< attribute name
+      !----------------------------------------------------------------
+
+      ! init
+      cm_dumatt(:)=''
+
+      ! read namelist
+      INQUIRE(FILE=TRIM(cd_dummy), EXIST=ll_exist)
+      IF( ll_exist )THEN
+    
+         il_fileid=fct_getunit()
+   
+         OPEN( il_fileid, FILE=TRIM(cd_dummy), &
+         &                FORM='FORMATTED',       &
+         &                ACCESS='SEQUENTIAL',    &
+         &                STATUS='OLD',           &
+         &                ACTION='READ',          &
+         &                IOSTAT=il_status)
+         CALL fct_err(il_status)
+         IF( il_status /= 0 )THEN
+            CALL logger_fatal("DIM GET DUMMY: opening "//TRIM(cd_dummy))
+         ENDIF
+   
+         READ( il_fileid, NML = namdum )
+         cm_dumatt(:)=cn_dumatt(:)
+
+         CLOSE( il_fileid )
+
+      ENDIF
+   
+   END SUBROUTINE att_get_dummy
+   !-------------------------------------------------------------------
+   !> @brief This function check if attribute is defined as dummy attribute
+   !> in configuraton file
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial Version
+   !
+   !> @param[in] td_att attribute structure
+   !> @return true if attribute is dummy attribute
+   !-------------------------------------------------------------------
+   FUNCTION att_is_dummy(td_att)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TATT), INTENT(IN) :: td_att
+      
+      ! function
+      LOGICAL :: att_is_dummy
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      att_is_dummy=.FALSE.
+      DO ji=1,ip_maxdum
+         IF( fct_lower(td_att%c_name) == fct_lower(cm_dumatt(ji)) )THEN
+            att_is_dummy=.TRUE.
+            EXIT
+         ENDIF
+      ENDDO
+
+   END FUNCTION att_is_dummy
 END MODULE att
 
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/boundary.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/boundary.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/boundary.f90	(revision 6440)
@@ -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. 
+   !> @warn 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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/create_bathy.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/create_bathy.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/create_bathy.f90	(revision 6440)
@@ -8,5 +8,5 @@
 !> @file
 !> @brief 
-!> This program create fine grid bathymetry file.
+!> This program creates fine grid bathymetry file.
 !>
 !> @details
@@ -20,6 +20,12 @@
 !>    ./SIREN/bin/create_bathy create_bathy.nam
 !> @endcode
-!>    
-!>    create_bathy.nam comprise 7 namelists:<br/>
+!> <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 contains 7 namelists:<br/>
 !>       - logger namelist (namlog)
 !>       - config namelist (namcfg)
@@ -30,12 +36,8 @@
 !>       - output namelist (namout)
 !>    
-!>    @note 
-!>       All namelists have to be in file create_bathy.nam, however variables of
-!>       those namelists are all optional.
-!>
 !>    * _logger namelist (namlog)_:<br/>
 !>       - cn_logfile   : log filename
 !>       - cn_verbosity : verbosity ('trace','debug','info',
-!> 'warning','error','fatal')
+!> 'warning','error','fatal','none')
 !>       - in_maxerror  : maximum number of error allowed
 !>
@@ -43,4 +45,6 @@
 !>       - cn_varcfg : variable configuration file 
 !> (see ./SIREN/cfg/variable.cfg)
+!>       - cn_dumcfg : useless (dummy) configuration file, for useless 
+!> dimension or variable (see ./SIREN/cfg/dummy.cfg).
 !>
 !>    * _coarse grid namelist (namcrs)_:<br/>
@@ -52,30 +56,7 @@
 !>       - 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/>
-!>          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
-!>
-!>                requests must be separated by ';'.<br/>
-!>                order of requests does not matter.<br/>
-!>
-!>          informations about available method could be find in @ref interp,
-!>          @ref extrap and @ref filter modules.<br/>
-!>          Example: 'Bathymetry: 2*hamming(2,3); > 0'
-!>          @note 
-!>             If you do not specify a method which is required, 
-!>             default one is apply.
-!>          @warning 
-!>             variable name must be __Bathymetry__ here.
 !>       - cn_varfile : list of variable, and corresponding file.<br/> 
 !>          *cn_varfile* is the path and filename of the file where find
@@ -90,5 +71,4 @@
 !>                - ',' for line
 !>                - '/' for row
-!>                - '\' for level<br/>
 !>                Example:<br/>
 !>                   3,2,3/1,4,5  =>  @f$ \left( \begin{array}{ccc}
@@ -100,6 +80,30 @@
 !>             - 'Bathymetry:5000,5000,5000/5000,3000,5000/5000,5000,5000'
 !>
-!>          \image html  bathy_40.png 
-!>          \image latex bathy_30.png
+!>       - cn_varinfo : list of variable and extra information about request(s) 
+!>       to be used.<br/>
+!>          each elements of *cn_varinfo* is a string character
+!>          (separated by ',').<br/>
+!>          it is composed of the variable name follow by ':', 
+!>          then request(s) to be used on this variable.<br/> 
+!>          request could be:
+!>             - int = interpolation method
+!>             - ext = extrapolation method
+!>             - flt = filter method
+!>             - min = minimum value
+!>             - max = maximum value
+!>             - unt = new units
+!>             - unf = unit scale factor (linked to new units)
+!>
+!>                requests must be separated by ';'.<br/>
+!>                order of requests does not matter.<br/>
+!>
+!>          informations about available method could be find in @ref interp,
+!>          @ref extrap and @ref filter modules.<br/>
+!>          Example: 'Bathymetry: flt=2*hamming(2,3); min=0'
+!>          @note 
+!>             If you do not specify a method which is required, 
+!>             default one is apply.
+!>          @warning 
+!>             variable name must be __Bathymetry__ here.
 !>
 !>    * _nesting namelist (namnst)_:<br/>
@@ -119,5 +123,18 @@
 !> - add header for user
 !> - Bug fix, compute offset depending of grid point
+!> @date June, 2015
+!> - extrapolate all land points.
+!> - allow to change unit.
+!> @date September, 2015
+!> - manage useless (dummy) variable, attributes, and dimension
+!> @date January,2016
+!> - add create_bathy_check_depth as in create_boundary
+!> - add create_bathy_check_time  as in create_boundary
+!> @date February, 2016
+!> - do not closed sea for east-west cyclic domain
 !
+!> @todo
+!> - check tl_multi is not empty
+!>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
 !----------------------------------------------------------------------
@@ -154,5 +171,4 @@
    INTEGER(i4)                                        :: il_status
    INTEGER(i4)                                        :: il_fileid
-   INTEGER(i4)                                        :: il_varid
    INTEGER(i4)                                        :: il_attid
    INTEGER(i4)                                        :: il_imin0
@@ -166,4 +182,5 @@
 
    LOGICAL                                            :: ll_exist
+   LOGICAL                                            :: ll_fillclosed
 
    TYPE(TMPP)                                         :: tl_coord0
@@ -195,30 +212,31 @@
    ! namelist variable
    ! namlog
-   CHARACTER(LEN=lc) :: cn_logfile = 'create_bathy.log' 
-   CHARACTER(LEN=lc) :: cn_verbosity = 'warning' 
-   INTEGER(i4)       :: in_maxerror = 5
+   CHARACTER(LEN=lc)                       :: cn_logfile = 'create_bathy.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 = './cfg/variable.cfg' 
+   CHARACTER(LEN=lc)                       :: cn_dumcfg = './cfg/dummy.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 = ''
-   INTEGER(i4)       :: in_perio1 = -1
-   LOGICAL           :: ln_fillclosed = .TRUE.
+   CHARACTER(LEN=lc)                       :: cn_coord1 = ''
+   INTEGER(i4)                             :: in_perio1 = -1
+   LOGICAL                                 :: ln_fillclosed = .TRUE.
 
    ! namvar
+   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = ''
    CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = ''
-   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = ''
 
    ! namnst
-   INTEGER(i4)       :: in_rhoi  = 1
-   INTEGER(i4)       :: in_rhoj  = 1
+   INTEGER(i4)                             :: in_rhoi  = 1
+   INTEGER(i4)                             :: in_rhoj  = 1
 
    ! namout
-   CHARACTER(LEN=lc) :: cn_fileout = 'bathy_fine.nc' 
+   CHARACTER(LEN=lc)                       :: cn_fileout = 'bathy_fine.nc' 
    !-------------------------------------------------------------------
 
@@ -229,5 +247,6 @@
 
    NAMELIST /namcfg/ &   !< configuration namelist
-   &  cn_varcfg          !< variable configuration file
+   &  cn_varcfg, &       !< variable configuration file
+   &  cn_dumcfg          !< dummy configuration file
 
    NAMELIST /namcrs/ &   !< coarse grid namelist
@@ -241,6 +260,6 @@
  
    NAMELIST /namvar/ &   !< variable namelist
-   &  cn_varinfo, &      !< list of variable and interpolation method to be used. (ex: 'votemper:linear','vosaline:cubic' )
-   &  cn_varfile         !< list of variable file
+   &  cn_varfile, &      !< list of variable file
+   &  cn_varinfo         !< list of variable and interpolation method to be used. (ex: 'votemper:linear','vosaline:cubic' )
    
    NAMELIST /namnst/ &   !< nesting namelist
@@ -289,4 +308,11 @@
       CALL var_def_extra(TRIM(cn_varcfg))
 
+      ! get dummy variable
+      CALL var_get_dummy(TRIM(cn_dumcfg))
+      ! get dummy dimension
+      CALL dim_get_dummy(TRIM(cn_dumcfg))
+      ! get dummy attribute
+      CALL att_get_dummy(TRIM(cn_dumcfg))
+
       READ( il_fileid, NML = namcrs )
       READ( il_fileid, NML = namfin )
@@ -296,5 +322,5 @@
       ! match variable with file
       tl_multi=multi_init(cn_varfile)
-      
+ 
       READ( il_fileid, NML = namnst )
       READ( il_fileid, NML = namout )
@@ -309,4 +335,5 @@
 
       PRINT *,"ERROR in create_bathy: can't find "//TRIM(cl_namelist)
+      STOP
 
    ENDIF
@@ -330,4 +357,8 @@
       &     "check namelist")
    ENDIF
+
+   ! do not closed sea for east-west cyclic domain
+   ll_fillclosed=ln_fillclosed
+   IF( tl_coord1%i_perio == 1 ) ll_fillclosed=.FALSE.
 
    ! check
@@ -404,42 +435,14 @@
 
             ! get or check depth value
-            IF( tl_multi%t_mpp(ji)%t_proc(1)%i_depthid /= 0 )THEN
-               il_varid=tl_multi%t_mpp(ji)%t_proc(1)%i_depthid
-               IF( ASSOCIATED(tl_depth%d_value) )THEN
-                  tl_tmp=iom_mpp_read_var(tl_mpp,il_varid)
-                  IF( ANY( tl_depth%d_value(:,:,:,:) /= &
-                  &        tl_tmp%d_value(:,:,:,:) ) )THEN
-                     CALL logger_fatal("CREATE BATHY: depth value from "//&
-                     &  TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//&
-                     &  " to those from former file(s).")
-                  ENDIF
-                  CALL var_clean(tl_tmp)
-               ELSE
-                  tl_depth=iom_mpp_read_var(tl_mpp,il_varid)
-               ENDIF
-            ENDIF
+            CALL create_bathy_check_depth( tl_mpp, tl_depth )
 
             ! get or check time value
-            IF( tl_multi%t_mpp(ji)%t_proc(1)%i_timeid /= 0 )THEN
-               il_varid=tl_multi%t_mpp(ji)%t_proc(1)%i_timeid
-               IF( ASSOCIATED(tl_time%d_value) )THEN
-                  tl_tmp=iom_mpp_read_var(tl_mpp,il_varid)
-                  IF( ANY( tl_time%d_value(:,:,:,:) /= &
-                  &        tl_tmp%d_value(:,:,:,:) ) )THEN
-                     CALL logger_fatal("CREATE BATHY: time value from "//&
-                     &  TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//&
-                     &  " to those from former file(s).")
-                  ENDIF
-                  CALL var_clean(tl_tmp)
-               ELSE
-                  tl_time=iom_mpp_read_var(tl_mpp,il_varid)
-               ENDIF
-            ENDIF
+            CALL create_bathy_check_time( tl_mpp, tl_time )
 
             ! close mpp file
             CALL iom_mpp_close(tl_mpp)
 
-            IF( ANY( tl_mpp%t_dim(1:2)%i_len /= &
-            &        tl_coord0%t_dim(1:2)%i_len) )THEN
+            IF( ANY(tl_mpp%t_dim(1:2)%i_len /= tl_coord0%t_dim(1:2)%i_len).OR.&
+            &   ALL(il_rho(:)==1) )THEN
                !- extract bathymetry from fine grid bathymetry 
                DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
@@ -482,10 +485,15 @@
    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))
 
          ! fill closed sea
-         IF( ln_fillclosed )THEN
+         IF( ll_fillclosed )THEN
             ALLOCATE( il_mask(tl_var(jk)%t_dim(1)%i_len, &
             &                 tl_var(jk)%t_dim(2)%i_len) )
@@ -508,5 +516,5 @@
          &   dl_minbat <= 0._dp  )THEN
             CALL logger_debug("CREATE BATHY: min value "//TRIM(fct_str(dl_minbat)))
-            CALL logger_error("CREATE BATHY: Bathymetry has value <= 0")
+            CALL logger_fatal("CREATE BATHY: Bathymetry has value <= 0")
          ENDIF
 
@@ -557,5 +565,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 +631,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] td_var    variable structure 
@@ -759,5 +767,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] td_var    variable structure 
@@ -878,5 +886,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] td_var    variable structure
@@ -897,10 +905,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
@@ -955,4 +963,6 @@
       CALL dom_del_extra( tl_var, tl_dom, il_rho(:) )
 
+      CALL dom_clean_extra( tl_dom )
+
       !- add ghost cell
       CALL grid_add_ghost(tl_var,tl_dom%i_ghost(:,:))
@@ -989,5 +999,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_var variable structure 
@@ -1073,7 +1083,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
@@ -1093,3 +1101,111 @@
 
    END SUBROUTINE create_bathy_interp
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine get depth variable value in an open mpp structure
+   !> and check if agree with already input depth variable.
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date January, 2016 - Initial Version
+   !>
+   !> @param[in] td_mpp       mpp structure
+   !> @param[inout] td_depth  depth variable structure 
+   !-------------------------------------------------------------------
+   SUBROUTINE create_bathy_check_depth( td_mpp, td_depth )
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP) , INTENT(IN   ) :: td_mpp
+      TYPE(TVAR) , INTENT(INOUT) :: td_depth
+
+      ! local variable
+      INTEGER(i4) :: il_varid
+      TYPE(TVAR)  :: tl_depth
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! get or check depth value
+      IF( td_mpp%t_proc(1)%i_depthid /= 0 )THEN
+
+         il_varid=td_mpp%t_proc(1)%i_depthid
+         IF( ASSOCIATED(td_depth%d_value) )THEN
+
+            tl_depth=iom_mpp_read_var(td_mpp, il_varid)
+
+            IF( ANY( td_depth%d_value(:,:,:,:) /= &
+            &        tl_depth%d_value(:,:,:,:) ) )THEN
+
+               CALL logger_warn("CREATE BATHY: depth value from "//&
+               &  TRIM(td_mpp%c_name)//" not conform "//&
+               &  " to those from former file(s).")
+
+            ENDIF
+            CALL var_clean(tl_depth)
+
+         ELSE
+            td_depth=iom_mpp_read_var(td_mpp,il_varid)
+         ENDIF
+
+      ENDIF
+      
+   END SUBROUTINE create_bathy_check_depth
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine get date and time in an open mpp structure
+   !> and check if agree with date and time already read.
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date January, 2016 - Initial Version
+   !>
+   !> @param[in] td_mpp      mpp structure
+   !> @param[inout] td_time  time variable structure 
+   !-------------------------------------------------------------------
+   SUBROUTINE create_bathy_check_time( td_mpp, td_time )
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP), INTENT(IN   ) :: td_mpp
+      TYPE(TVAR), INTENT(INOUT) :: td_time
+
+      ! local variable
+      INTEGER(i4) :: il_varid
+      TYPE(TVAR)  :: tl_time
+
+      TYPE(TDATE) :: tl_date1
+      TYPE(TDATE) :: tl_date2
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! get or check depth value
+      IF( td_mpp%t_proc(1)%i_timeid /= 0 )THEN
+
+         il_varid=td_mpp%t_proc(1)%i_timeid
+         IF( ASSOCIATED(td_time%d_value) )THEN
+
+            tl_time=iom_mpp_read_var(td_mpp, il_varid)
+
+            tl_date1=var_to_date(td_time)
+            tl_date2=var_to_date(tl_time)
+            IF( tl_date1 - tl_date2 /= 0 )THEN
+
+               CALL logger_warn("CREATE BATHY: date from "//&
+               &  TRIM(td_mpp%c_name)//" not conform "//&
+               &  " to those from former file(s).")
+
+            ENDIF
+            CALL var_clean(tl_time)
+
+         ELSE
+            td_time=iom_mpp_read_var(td_mpp,il_varid)
+         ENDIF
+
+      ENDIF
+      
+   END SUBROUTINE create_bathy_check_time
 END PROGRAM create_bathy
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/create_boundary.F90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/create_boundary.F90	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/create_boundary.F90	(revision 6440)
@@ -0,0 +1,1764 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+!
+! PROGRAM: create_boundary
+!
+! DESCRIPTION:
+!> @file
+!> @brief 
+!> This program creates boundary files.
+!>
+!> @details
+!> @section sec1 method
+!> Variables are read from coarse grid standard output, 
+!> extracted or interpolated on fine grid. 
+!> Variables could also be manually written.<br/>
+!> @note 
+!>    method could be different for each variable.
+!>
+!> @section sec2 how to 
+!>    to create boundaries files:<br/>
+!> @code{.sh}
+!>    ./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 contains 9 namelists:<br/>
+!>       - logger namelist (namlog)
+!>       - config namelist (namcfg)
+!>       - coarse grid namelist (namcrs)
+!>       - fine grid namelist (namfin)
+!>       - variable namelist (namvar)
+!>       - nesting namelist (namnst)
+!>       - boundary namelist (nambdy)
+!>       - vertical grid namelist (namzgr)
+!>       - output namelist (namout)
+!>    
+!>    * _logger namelist (namlog)_:<br/>
+!>       - cn_logfile   : log filename
+!>       - cn_verbosity : verbosity ('trace','debug','info',
+!> 'warning','error','fatal','none')
+!>       - in_maxerror  : maximum number of error allowed
+!>
+!>    * _config namelist (namcfg)_:<br/>
+!>       - cn_varcfg : variable configuration file
+!> (see ./SIREN/cfg/variable.cfg)
+!>       - cn_dumcfg : useless (dummy) configuration file, for useless 
+!> dimension or variable (see ./SIREN/cfg/dummy.cfg).
+!>
+!>    * _coarse grid namelist (namcrs)_:<br/>
+!>       - cn_coord0 : coordinate file
+!>       - in_perio0 : NEMO periodicity index (see Model Boundary Condition in
+!> [NEMO documentation](http://www.nemo-ocean.eu/About-NEMO/Reference-manuals))
+!>
+!>    * _fine grid namelist (namfin)_:<br/>
+!>       - cn_coord1 : coordinate file
+!>       - cn_bathy1 : bathymetry file
+!>       - in_perio1 : periodicity index
+!>
+!>    * _vertical grid namelist (namzgr)_:<br/>
+!>       - 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
+!>
+!>    * _partial step namelist (namzps)_:<br/>
+!>       - dn_e3zps_min          :
+!>       - dn_e3zps_rat          : 
+!>
+!>    * _variable namelist (namvar)_:<br/>
+!>       - cn_varfile : list of variable, and associated file<br/> 
+!>          *cn_varfile* is the path and filename of the file where find
+!>          variable.<br/> 
+!>          @note 
+!>             *cn_varfile* could be a matrix of value, if you want to filled
+!>             manually variable value.<br/>
+!>             the variable array of value is split into equal subdomain.<br/>
+!>             Each subdomain is filled with the corresponding value 
+!>             of the matrix.<br/>          
+!>             separators used to defined matrix are:
+!>                - ',' for line
+!>                - '/' for row
+!>                - '\' for level<br/>
+!>                Example:<br/>
+!>                   3,2,3/1,4,5  =>  @f$ \left( \begin{array}{ccc}
+!>                                         3 & 2 & 3 \\\\
+!>                                         1 & 4 & 5 \end{array} \right) @f$
+!>          @warning 
+!>             the same matrix is used for all boundaries.
+!>
+!>       Examples: 
+!>          - 'votemper:gridT.nc', 'vozocrtx:gridU.nc'
+!>          - 'votemper:10\25', 'vozocrtx:gridU.nc'
+!>
+!>       - cn_varinfo : list of variable and extra information about request(s)
+!>          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:
+!>             - 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/>
+!>                order of requests does not matter.
+!>
+!>          informations about available method could be find in @ref interp,
+!>          @ref extrap and @ref filter.<br/>
+!>
+!>          Example: 'votemper:int=linear;flt=hann;ext=dist_weight', 
+!>                   'vosaline:int=cubic'
+!>          @note 
+!>             If you do not specify a method which is required, 
+!>             default one is apply.
+!>
+!>    * _nesting namelist (namnst)_:<br/>
+!>       - in_rhoi  : refinement factor in i-direction
+!>       - in_rhoj  : refinement factor in j-direction
+!>
+!>    * _boundary namelist (nambdy)_:<br/>
+!>       - ln_north  : use north boundary
+!>       - ln_south  : use south boundary
+!>       - ln_east   : use east  boundary
+!>       - ln_west   : use west  boundary
+!>       - cn_north  : north boundary indices on fine grid
+!>          *cn_north* is a string character defining boundary
+!>          segmentation.<br/>
+!>          segments are separated by '|'.<br/>
+!>          each segments of the boundary is composed of:
+!>             - indice of velocity (orthogonal to boundary .ie. 
+!>                for north boundary, J-indice). 
+!>             - indice of segment start (I-indice for north boundary) 
+!>             - indice of segment end   (I-indice for north boundary)<br/>
+!>                indices must be separated by ':' .<br/>
+!>             - optionally, boundary size could be added between '(' and ')' 
+!>             in the definition of the first segment.
+!>                @note 
+!>                   boundary width is the same for all segments of one boundary.
+!>
+!>          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_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 : force to use only one segment for each boundary or not
+!>
+!>    * _output namelist (namout)_:<br/>
+!>       - cn_fileout : fine grid boundary basename
+!>         (cardinal point 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
+! REVISION HISTORY:
+!> @date November, 2013 - Initial Version
+!> @date September, 2014
+!> - add header for user
+!> - take into account grid point to compue boundaries
+!> - reorder output dimension for north and south boundaries
+!> @date June, 2015
+!> - extrapolate all land points, and add ln_extrap in namelist.
+!> - allow to change unit.
+!> @date July, 2015
+!> - add namelist parameter to shift date of output file name.
+!> @date September, 2015
+!> - manage useless (dummy) variable, attributes, and dimension
+!> - allow to run on multi processors with key_mpp_mpi
+!> @date January, 2016
+!> - same process use for variable extracted or interpolated from input file.
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+PROGRAM create_boundary
+
+   USE netcdf                          ! nf90 library
+   USE global                          ! global variable
+   USE phycst                          ! physical constant
+   USE kind                            ! F90 kind parameter
+   USE fct                             ! basic useful function
+   USE date                            ! date manager
+   USE att                             ! attribute manager
+   USE dim                             ! dimension manager
+   USE var                             ! variable manager
+   USE file                            ! file manager
+   USE multi                           ! multi file manager
+   USE boundary                        ! boundary manager
+   USE iom                             ! I/O manager
+   USE dom                             ! domain manager
+   USE grid                            ! grid manager
+   USE vgrid                           ! vertical grid manager
+   USE extrap                          ! extrapolation manager
+   USE interp                          ! interpolation manager
+   USE filter                          ! filter manager
+   USE mpp                             ! MPP manager
+   USE iom_mpp                         ! MPP I/O manager
+
+   IMPLICIT NONE
+
+   ! local variable
+   INTEGER(i4)                                        :: il_narg
+
+#if defined key_mpp_mpi
+   ! mpp variable
+   CHARACTER(LEN=lc), DIMENSION(:)      , ALLOCATABLE :: cl_namelist
+   INTEGER(i4)                                        :: ierror
+   INTEGER(i4)                                        :: iproc
+   INTEGER(i4)                                        :: nproc
+   INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_nprog
+
+   ! loop indices
+   INTEGER(i4) :: jm
+#else
+   CHARACTER(LEN=lc)                                  :: cl_namelist
+#endif
+   !-------------------------------------------------------------------
+#if defined key_mpp_mpi
+   INCLUDE 'mpif.h'
+#endif
+   !-------------------------------------------------------------------
+
+   il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec
+#if ! defined key_mpp_mpi
+
+   IF( il_narg/=1 )THEN
+      PRINT *,"CREATE BOUNDARY: ERROR. need one namelist"
+      STOP
+   ELSE
+      CALL GET_COMMAND_ARGUMENT(1,cl_namelist) !f03 intrinsec
+   ENDIF
+
+   CALL create__boundary(cl_namelist)
+
+#else
+
+   ! Initialize MPI
+   CALL mpi_init(ierror)
+   CALL mpi_comm_rank(mpi_comm_world,iproc,ierror)
+   CALL mpi_comm_size(mpi_comm_world,nproc,ierror)
+
+   IF( il_narg==0 )THEN
+      PRINT *,"CREATE BOUNDARY: ERROR. need at least one namelist"
+      STOP
+   ELSE
+      ALLOCATE(cl_namelist(il_narg))
+      DO jm=1,il_narg
+         CALL GET_COMMAND_ARGUMENT(jm,cl_namelist(jm))
+      ENDDO
+   ENDIF
+
+   ALLOCATE(il_nprog(il_narg))
+   DO jm=1, il_narg
+      il_nprog(jm)= MOD(jm,nproc)
+   ENDDO
+
+   DO jm=1, il_narg
+      IF ( il_nprog(jm) .eq. iproc ) THEN
+         CALL create__boundary(cl_namelist(jm))
+      ENDIF
+   ENDDO
+
+   CALL mpi_finalize(ierror)
+
+   DEALLOCATE(cl_namelist)
+   DEALLOCATE(il_nprog)
+#endif
+
+CONTAINS
+SUBROUTINE create__boundary(cd_namelist)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine create boundary files.
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date January, 2016 - Initial Version
+   !>
+   !> @param[in] cd_namelist namelist file 
+   !-------------------------------------------------------------------
+
+   USE logger                          ! log file manager
+
+   IMPLICIT NONE
+   ! Argument
+   CHARACTER(LEN=lc), INTENT(IN) :: cd_namelist 
+
+   ! local variable
+   CHARACTER(LEN=lc)                                  :: cl_date
+   CHARACTER(LEN=lc)                                  :: cl_name
+   CHARACTER(LEN=lc)                                  :: cl_bdyout
+   CHARACTER(LEN=lc)                                  :: cl_data
+   CHARACTER(LEN=lc)                                  :: cl_dimorder
+   CHARACTER(LEN=lc)                                  :: cl_fmt
+
+   INTEGER(i4)                                        :: il_status
+   INTEGER(i4)                                        :: il_fileid
+   INTEGER(i4)                                        :: il_imin0
+   INTEGER(i4)                                        :: il_imax0
+   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_offset
+   INTEGER(i4)      , DIMENSION(2,2)                  :: il_ind
+
+   LOGICAL                                            :: ll_exist
+
+   TYPE(TATT)                                         :: tl_att
+   
+   TYPE(TVAR)                                         :: tl_depth   
+   TYPE(TVAR)                                         :: tl_time
+   TYPE(TVAR)                                         :: tl_var1
+   TYPE(TVAR)                                         :: tl_var0
+   TYPE(TVAR)                                         :: tl_lon1
+   TYPE(TVAR)                                         :: tl_lat1
+   TYPE(TVAR)                                         :: tl_lvl1  
+   TYPE(TVAR)       , DIMENSION(:)      , ALLOCATABLE :: tl_level
+   TYPE(TVAR)       , DIMENSION(:,:,:)  , ALLOCATABLE :: tl_seglvl1
+   TYPE(TVAR)       , DIMENSION(:,:,:)  , ALLOCATABLE :: tl_segvar1
+
+   TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim
+
+   TYPE(TDATE)                                        :: tl_date
+   
+   TYPE(TBDY)       , DIMENSION(ip_ncard)             :: tl_bdy
+   
+   TYPE(TDOM)                                         :: tl_dom0
+   TYPE(TDOM)                                         :: tl_dom1
+   TYPE(TDOM)       , DIMENSION(:,:,:)  , ALLOCATABLE :: tl_segdom1
+
+   TYPE(TFILE)                                        :: tl_fileout
+   
+   TYPE(TMPP)                                         :: tl_coord0
+   TYPE(TMPP)                                         :: tl_coord1
+   TYPE(TMPP)                                         :: tl_bathy1
+   TYPE(TMPP)                                         :: tl_mpp
+
+   TYPE(TMULTI)                                       :: tl_multi
+
+   ! loop indices
+   INTEGER(i4) :: jvar
+   INTEGER(i4) :: jpoint
+   INTEGER(i4) :: ji
+   INTEGER(i4) :: jj
+   INTEGER(i4) :: jk
+   INTEGER(i4) :: jl
+
+   ! namelist variable
+   ! namlog
+   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_dumcfg = 'dummy.cfg'
+
+   ! namcrs
+   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
+
+   !namzgr
+   REAL(dp)                                :: dn_pp_to_be_computed = 0._dp
+   REAL(dp)                                :: dn_ppsur   = -3958.951371276829_dp
+   REAL(dp)                                :: dn_ppa0    =   103.953009600000_dp
+   REAL(dp)                                :: dn_ppa1    =     2.415951269000_dp
+   REAL(dp)                                :: dn_ppa2    =   100.760928500000_dp
+   REAL(dp)                                :: dn_ppkth   =    15.351013700000_dp
+   REAL(dp)                                :: dn_ppkth2  =    48.029893720000_dp
+   REAL(dp)                                :: dn_ppacr   =     7.000000000000_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
+   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = ''
+   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = ''
+
+   ! namnst
+   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.
+   LOGICAL                                 :: ln_oneseg  = .TRUE.
+   CHARACTER(LEN=lc)                       :: cn_north   = ''
+   CHARACTER(LEN=lc)                       :: cn_south   = ''
+   CHARACTER(LEN=lc)                       :: cn_east    = ''
+   CHARACTER(LEN=lc)                       :: cn_west    = ''
+
+   ! namout
+   CHARACTER(LEN=lc)                       :: cn_fileout = 'boundary.nc' 
+   REAL(dp)                                :: dn_dayofs  = 0._dp
+   LOGICAL                                 :: ln_extrap  = .FALSE.
+   !-------------------------------------------------------------------
+
+   NAMELIST /namlog/ &  !< logger namelist
+   &  cn_logfile,    &  !< log file
+   &  cn_verbosity,  &  !< log verbosity
+   &  in_maxerror
+
+   NAMELIST /namcfg/ &  !< config namelist
+   &  cn_varcfg, &       !< variable configuration file
+   &  cn_dumcfg          !< dummy configuration file
+
+   NAMELIST /namcrs/ &  !< coarse grid namelist
+   &  cn_coord0,     &  !< coordinate file
+   &  in_perio0         !< periodicity index
+ 
+   NAMELIST /namfin/ &  !< fine grid namelist
+   &  cn_coord1,     &  !< coordinate file
+   &  cn_bathy1,     &  !< bathymetry file
+   &  in_perio1         !< periodicity index
+ 
+   NAMELIST /namzgr/ &
+   &  dn_pp_to_be_computed, &
+   &  dn_ppsur,     &
+   &  dn_ppa0,      &
+   &  dn_ppa1,      &
+   &  dn_ppa2,      &
+   &  dn_ppkth,     &
+   &  dn_ppkth2,    &
+   &  dn_ppacr,     &
+   &  dn_ppacr2,    &
+   &  dn_ppdzmin,   &
+   &  dn_pphmax,    &
+   &  in_nlevel         !< number of vertical level
+
+   NAMELIST /namzps/ &
+   &  dn_e3zps_min, &
+   &  dn_e3zps_rat
+
+   NAMELIST /namvar/ &  !< variable namelist
+   &  cn_varfile, &     !< list of variable and file where find it. (ex: 'votemper:GLORYS_gridT.nc' ) 
+   &  cn_varinfo        !< list of variable and method to apply on. (ex: 'votemper:linear','vosaline:cubic' )
+ 
+   NAMELIST /namnst/ &  !< nesting namelist
+   &  in_rhoi,       &  !< refinement factor in i-direction
+   &  in_rhoj           !< refinement factor in j-direction
+
+   NAMELIST /nambdy/ &  !< boundary namelist
+   &  ln_north,      &  !< use north boundary
+   &  ln_south,      &  !< use south boundary
+   &  ln_east ,      &  !< use east  boundary
+   &  ln_west ,      &  !< use west  boundary
+   &  cn_north,      &  !< north boundary indices on fine grid
+   &  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
+
+   NAMELIST /namout/ &  !< output namelist
+   &  cn_fileout,    &  !< fine grid boundary file basename   
+   &  dn_dayofs,     &  !< date offset in day (change only ouput file name)
+   &  ln_extrap         !< extrapolate or not
+   !-------------------------------------------------------------------
+
+   ! read namelist
+   INQUIRE(FILE=TRIM(cd_namelist), EXIST=ll_exist)
+
+   IF( ll_exist )THEN
+      
+      il_fileid=fct_getunit()
+
+      OPEN( il_fileid, FILE=TRIM(cd_namelist), &
+      &                FORM='FORMATTED',       &
+      &                ACCESS='SEQUENTIAL',    &
+      &                STATUS='OLD',           &
+      &                ACTION='READ',          &
+      &                IOSTAT=il_status)
+      CALL fct_err(il_status)
+      IF( il_status /= 0 )THEN
+         PRINT *,"CREATE BOUNDARY: ERROR opening "//TRIM(cd_namelist)
+         STOP
+      ENDIF
+
+      READ( il_fileid, NML = namlog )
+      ! define log file
+      CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror)
+      CALL logger_header()
+
+      READ( il_fileid, NML = namcfg )
+      ! get variable extra information
+      CALL var_def_extra(TRIM(cn_varcfg))
+
+      ! get dummy variable
+      CALL var_get_dummy(TRIM(cn_dumcfg))
+      ! get dummy dimension
+      CALL dim_get_dummy(TRIM(cn_dumcfg))
+      ! get dummy attribute
+      CALL att_get_dummy(TRIM(cn_dumcfg))
+
+      READ( il_fileid, NML = namcrs )
+      READ( il_fileid, NML = namfin )
+      READ( il_fileid, NML = namzgr )
+      READ( il_fileid, NML = namvar )
+      ! add user change in extra information
+      CALL var_chg_extra(cn_varinfo)
+      ! match variable with file
+      tl_multi=multi_init(cn_varfile)
+
+      READ( il_fileid, NML = namnst )
+      READ( il_fileid, NML = nambdy )
+      READ( il_fileid, NML = namout )
+
+      CLOSE( il_fileid, IOSTAT=il_status )
+      CALL fct_err(il_status)
+      IF( il_status /= 0 )THEN
+         CALL logger_error("CREATE BOUNDARY: ERROR closing "//TRIM(cd_namelist))
+      ENDIF
+
+   ELSE
+
+      PRINT *,"CREATE BOUNDARY: ERROR. can not find "//TRIM(cd_namelist)
+      STOP
+
+   ENDIF
+
+   CALL multi_print(tl_multi)
+   IF( tl_multi%i_nvar <= 0 )THEN
+      CALL logger_fatal("CREATE BOUNDARY: no variable to be used."//&
+      &  " check namelist.")
+   ENDIF
+
+   ! open files
+   IF( TRIM(cn_coord0) /= '' )THEN
+      tl_coord0=mpp_init( file_init(TRIM(cn_coord0)), id_perio=in_perio0)
+      CALL grid_get_info(tl_coord0)
+   ELSE
+      CALL logger_fatal("CREATE BOUNDARY: can not find coarse grid "//&
+      &  "coordinate file. check namelist")
+   ENDIF
+
+   IF( TRIM(cn_coord1) /= '' )THEN
+      tl_coord1=mpp_init( file_init(TRIM(cn_coord1)), id_perio=in_perio1)
+      CALL grid_get_info(tl_coord1)
+   ELSE
+      CALL logger_fatal("CREATE BOUNDARY: can not find fine grid coordinate "//&
+      &  "file. check namelist")
+   ENDIF
+
+   IF( TRIM(cn_bathy1) /= '' )THEN
+      tl_bathy1=mpp_init( file_init(TRIM(cn_bathy1)), id_perio=in_perio1)
+      CALL grid_get_info(tl_bathy1)
+   ELSE
+      CALL logger_fatal("CREATE BOUNDARY: can not find fine grid bathymetry "//&
+      &  "file. check namelist")
+   ENDIF
+
+   ! 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
+         CALL logger_fatal("CREATE BOUNDARY: output file "//TRIM(cl_bdyout)//&
+         &  " already exist.")
+      ENDIF
+   ENDDO
+
+   ! check namelist
+   ! check refinement factor
+   il_rho(:)=1
+   IF( in_rhoi < 1 .OR. in_rhoj < 1 )THEN
+      CALL logger_error("CREATE BOUNDARY: invalid refinement factor."//&
+      &  " check namelist "//TRIM(cd_namelist))
+   ELSE
+      il_rho(jp_I)=in_rhoi
+      il_rho(jp_J)=in_rhoj
+   ENDIF
+
+   !
+   ! compute coarse grid indices around fine grid
+   il_ind(:,:)=grid_get_coarse_index(tl_coord0, tl_coord1, &
+   &                                 id_rho=il_rho(:))
+
+   il_imin0=il_ind(1,1) ; il_imax0=il_ind(1,2)
+   il_jmin0=il_ind(2,1) ; il_jmax0=il_ind(2,2)
+
+   ! check domain validity
+   CALL grid_check_dom(tl_coord0, il_imin0, il_imax0, il_jmin0, il_jmax0)
+
+   ! check coordinate file
+   CALL grid_check_coincidence( tl_coord0, tl_coord1, &
+   &                            il_imin0, il_imax0, &
+   &                            il_jmin0, il_jmax0, &
+   &                            il_rho(:) )      
+
+   ! read or compute boundary
+   CALL mpp_get_contour(tl_bathy1)
+
+   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, &
+   &                                ln_oneseg ) 
+
+
+   CALL var_clean(tl_var1)
+
+   ! compute level
+   ALLOCATE(tl_level(ip_npoint))
+   tl_level(:)=vgrid_get_level(tl_bathy1, cd_namelist )
+
+   ! 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
+         DO jk=1,tl_bdy(jl)%i_nseg
+
+            ! get fine grid segment domain
+            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)
+            ! to avoid dimension of one and so be able to compute offset
+            DO jj=1,ip_npoint
+               CALL dom_add_extra(tl_segdom1(jj,jk,jl), &
+               &                  il_rho(jp_I), il_rho(jp_J))
+            ENDDO
+
+         ENDDO
+      ENDIF
+   ENDDO
+
+   ! clean
+   CALL var_clean(tl_level(:))
+   DEALLOCATE(tl_level)
+
+   ! clean bathy
+   CALL mpp_clean(tl_bathy1)
+
+   ALLOCATE( tl_segvar1(tl_multi%i_nvar,ip_maxseg,ip_ncard) )
+   ! compute boundary for variable to be used (see namelist)
+   IF( .NOT. ASSOCIATED(tl_multi%t_mpp) )THEN
+      CALL logger_error("CREATE BOUNDARY: no file to work on. "//&
+      &                 "check cn_varfile in namelist.")
+   ELSE
+
+      jvar=0
+      ! for each file
+      DO ji=1,tl_multi%i_nmpp
+
+         WRITE(cl_data,'(a,i2.2)') 'data-',jvar+1
+
+         IF( .NOT. ASSOCIATED(tl_multi%t_mpp(ji)%t_proc(1)%t_var) )THEN
+
+            CALL logger_error("CREATE BOUNDARY: no variable to work on for "//&
+            &                 "mpp "//TRIM(tl_multi%t_mpp(ji)%c_name)//&
+            &                 ". check cn_varfile in namelist.")
+
+         ELSEIF( TRIM(tl_multi%t_mpp(ji)%c_name) == TRIM(cl_data) )THEN
+         !- use input matrix to fill variable
+
+            WRITE(*,'(a)') "work on data"
+            ! for each variable initialise from matrix
+            DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
+
+               jvar=jvar+1
+               WRITE(*,'(2x,a,a)') "work on variable "//&
+               &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name)
+
+               tl_var1=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj))
+
+               SELECT CASE(TRIM(tl_var1%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
+
+               WRITE(*,'(4x,a,a)') 'work on '//TRIM(tl_var1%c_name)
+               DO jl=1,ip_ncard
+                  IF( tl_bdy(jl)%l_use )THEN
+
+                     DO jk=1,tl_bdy(jl)%i_nseg
+
+                        ! fill value with matrix data
+                        tl_segvar1(jvar,jk,jl)=create_boundary_matrix( &
+                        &                          tl_var1, &
+                        &                          tl_segdom1(jpoint,jk,jl), &
+                        &                          in_nlevel )
+
+                        !del extra
+                        CALL dom_del_extra( tl_segvar1(jvar,jk,jl), &
+                        &                   tl_segdom1(jpoint,jk,jl) )
+
+                     ENDDO
+
+                  ENDIF
+               ENDDO
+               
+               ! clean
+               CALL var_clean(tl_var1)
+
+            ENDDO
+
+         !- end of use input matrix to fill variable
+         ELSE
+         !- use mpp file to fill variable
+
+            WRITE(*,'(a)') "work on file "//TRIM(tl_multi%t_mpp(ji)%c_name)
+            ! 
+            tl_mpp=mpp_init(file_init(TRIM(tl_multi%t_mpp(ji)%t_proc(1)%c_name)))
+            CALL grid_get_info(tl_mpp)
+
+            DO jl=1,ip_ncard
+               IF( tl_bdy(jl)%l_use )THEN
+
+                  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 "//&
+                        &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name)
+
+                        tl_var0=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj))
+
+                        ! open mpp file
+                        CALL iom_mpp_open(tl_mpp)
+
+                        ! get or check depth value
+                        CALL create_boundary_check_depth( tl_var0, tl_mpp, &
+                        &                                 in_nlevel, tl_depth )
+
+                        ! get or check time value
+                        CALL create_boundary_check_time( tl_var0, tl_mpp, &
+                        &                                tl_time )
+
+                        ! close mpp file
+                        CALL iom_mpp_close(tl_mpp)
+
+                        ! open mpp file on domain
+                        SELECT CASE(TRIM(tl_var0%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
+
+                        tl_dom1=dom_copy(tl_segdom1(jpoint,jk,jl))
+
+                        CALL create_boundary_get_coord( tl_coord1, tl_dom1, &
+                        &                               tl_var0%c_point,    &
+                        &                               tl_lon1, tl_lat1 )
+
+                        ! get coarse grid indices of this segment
+                        il_ind(:,:)=grid_get_coarse_index(tl_coord0, &
+                        &                                 tl_lon1, tl_lat1, &
+                        &                                 id_rho=il_rho(:) )
+
+                        IF( ANY(il_ind(:,:)==0) )THEN
+                           CALL logger_error("CREATE BOUNDARY: error "//&
+                           &  "computing coarse grid indices")
+                        ELSE
+                           il_imin0=il_ind(1,1)
+                           il_imax0=il_ind(1,2)
+
+                           il_jmin0=il_ind(2,1)
+                           il_jmax0=il_ind(2,2)
+                        ENDIF
+
+                        il_offset(:,:)= grid_get_fine_offset( &
+                        &                    tl_coord0, &
+                        &                    il_imin0, il_jmin0,&
+                        &                    il_imax0, il_jmax0,&
+                        &                    tl_lon1%d_value(:,:,1,1),&
+                        &                    tl_lat1%d_value(:,:,1,1),&
+                        &                    il_rho(:),&
+                        &                    TRIM(tl_var0%c_point) )
+
+                        ! compute coarse grid segment domain
+                        tl_dom0=dom_init( tl_coord0,         &
+                        &                 il_imin0, il_imax0,&
+                        &                 il_jmin0, il_jmax0 )
+
+                        ! add extra band (if possible) to compute interpolation
+                        CALL dom_add_extra(tl_dom0)
+
+                        ! open mpp files
+                        CALL iom_dom_open(tl_mpp, tl_dom0)
+
+                        cl_name=tl_var0%c_name
+                        ! read variable value on domain
+                        tl_segvar1(jvar+jj,jk,jl)= &
+                        &    iom_dom_read_var(tl_mpp, TRIM(cl_name), tl_dom0)
+
+                        IF( ANY(il_rho(:)/=1) )THEN
+                           WRITE(*,'(4x,a,a)') "interp variable "//TRIM(cl_name)
+                           ! work on variable
+                           CALL create_boundary_interp( &
+                           &                 tl_segvar1(jvar+jj,jk,jl),&
+                           &                 il_rho(:), il_offset(:,:) )
+                        ENDIF
+
+                        ! remove extraband added to domain
+                        CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), &
+                        &                   tl_dom0, il_rho(:) )
+
+                        ! del extra point on fine grid
+                        CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), &
+                        &                   tl_dom1 )
+                        ! clean extra point information on coarse grid domain
+                        CALL dom_clean_extra( tl_dom0 )
+
+                        ! add attribute to variable
+                        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_dom0%i_imin, tl_dom0%i_imax/))
+                        CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), &
+                        &                 tl_att)
+
+                        tl_att=att_init('src_j_indices', &
+                        &  (/tl_dom0%i_jmin, tl_dom0%i_jmax/))
+                        CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), &
+                        &                 tl_att)
+
+                        IF( ANY(il_rho(:)/=1) )THEN
+                           tl_att=att_init("refinment_factor", &
+                           &               (/il_rho(jp_I),il_rho(jp_J)/))
+                           CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), &
+                           &                 tl_att)
+                        ENDIF
+
+                        ! clean structure
+                        CALL att_clean(tl_att)
+
+                        ! clean
+                        CALL dom_clean(tl_dom0)
+                        CALL dom_clean(tl_dom1)
+
+                        ! close mpp files
+                        CALL iom_dom_close(tl_mpp)
+
+                        ! clean structure
+                        CALL var_clean(tl_lon1)
+                        CALL var_clean(tl_lat1)
+                        CALL var_clean(tl_lvl1)
+
+                     ENDDO ! jj
+
+                     ! clean
+                     CALL var_clean(tl_var0)
+
+                  ENDDO ! jk
+            
+               ENDIF
+            ENDDO ! jl
+
+            jvar=jvar+tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
+
+            ! clean
+            CALL mpp_clean(tl_mpp)
+
+         !- end of use file to fill variable
+         ENDIF
+      ENDDO ! ji
+   ENDIF
+
+   IF( jvar /= tl_multi%i_nvar )THEN
+      CALL logger_error("CREATE BOUNDARY: it seems some variable "//&
+         &  "can not be read")
+   ENDIF
+
+   ! write file for each segment of each boundary
+   DO jl=1,ip_ncard
+      IF( tl_bdy(jl)%l_use )THEN
+
+         DO jk=1,tl_bdy(jl)%i_nseg
+            !- 
+            CALL create_boundary_get_coord( tl_coord1, tl_segdom1(jp_T,jk,jl),&
+            &                               '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) )
+            CALL dom_del_extra( tl_lat1, tl_segdom1(jp_T,jk,jl) )
+
+            ! clean
+            DO jpoint=1,ip_npoint
+               CALL dom_clean(tl_segdom1(jpoint,jk,jl))
+            ENDDO
+
+            ! swap array
+            CALL boundary_swap(tl_lon1, tl_bdy(jl))
+            CALL boundary_swap(tl_lat1, tl_bdy(jl))
+            DO jvar=1,tl_multi%i_nvar
+
+               ! 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))
+
+               ! filter
+               CALL filter_fill_value(tl_segvar1(jvar,jk,jl))
+
+               IF( .NOT. ln_extrap )THEN
+                  ! use mask
+                  SELECT CASE(TRIM(tl_segvar1(jvar,jk,jl)%c_point))
+                  CASE DEFAULT !'T'
+                     jpoint=jp_T
+                  CASE('U')
+                     jpoint=jp_U
+                  CASE('V')
+                     jpoint=jp_V
+                  CASE('F')
+                     jpoint=jp_F
+                  END SELECT
+
+                  CALL create_boundary_use_mask(tl_segvar1(jvar,jk,jl), &
+                  &                             tl_seglvl1(jpoint,jk,jl))
+               ENDIF
+
+               ! swap dimension order
+               CALL boundary_swap(tl_segvar1(jvar,jk,jl), tl_bdy(jl))
+
+            ENDDO
+
+            ! create file
+            ! create file structure
+            ! set file namearray of level variable structure
+            IF( tl_bdy(jl)%i_nseg > 1 )THEN
+               IF( ASSOCIATED(tl_time%d_value) )THEN
+                  cl_fmt="('y',i0.4,'m',i0.2,'d',i0.2)"
+                  tl_date=var_to_date(tl_time)
+                  tl_date=tl_date+dn_dayofs
+                  cl_date=date_print( tl_date, cl_fmt ) 
+
+                  cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
+                  &                                TRIM(tl_bdy(jl)%c_card), jk,&
+                  &                                cd_date=TRIM(cl_date) )
+               ELSE
+                  cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
+                  &                                TRIM(tl_bdy(jl)%c_card), jk )
+               ENDIF
+            ELSE
+               IF( ASSOCIATED(tl_time%d_value) )THEN
+                  cl_fmt="('y',i0.4,'m',i0.2,'d',i0.2)"
+                  tl_date=var_to_date(tl_time)
+                  tl_date=tl_date+dn_dayofs
+                  cl_date=date_print( tl_date, cl_fmt )
+
+                  cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
+                  &                                TRIM(tl_bdy(jl)%c_card), &
+                  &                                cd_date=TRIM(cl_date) )
+               ELSE
+                  cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
+                  &                                TRIM(tl_bdy(jl)%c_card) )
+               ENDIF
+            ENDIF
+            ! 
+            tl_fileout=file_init(TRIM(cl_bdyout),id_perio=in_perio1)
+
+            ! add dimension
+            tl_dim(:)=var_max_dim(tl_segvar1(:,jk,jl))
+
+            SELECT CASE(TRIM(tl_bdy(jl)%c_card))
+               CASE DEFAULT ! 'north','south'
+                  cl_dimorder='xyzt'
+               CASE('east','west')
+                  cl_dimorder='yxzt'
+            END SELECT
+
+            DO ji=1,ip_maxdim
+               IF( tl_dim(ji)%l_use ) CALL file_add_dim(tl_fileout, tl_dim(ji))
+            ENDDO
+
+            ! add variables
+            IF( ALL( tl_dim(1:2)%l_use ) )THEN
+               ! add longitude
+               CALL file_add_var(tl_fileout, tl_lon1)
+               CALL var_clean(tl_lon1)
+
+               ! add latitude
+               CALL file_add_var(tl_fileout, tl_lat1)
+               CALL var_clean(tl_lat1)
+            ENDIF
+            
+
+
+            IF( tl_dim(3)%l_use )THEN
+               IF( ASSOCIATED(tl_depth%d_value) )THEN
+                  ! add depth
+                  CALL file_add_var(tl_fileout, tl_depth)
+               ENDIF
+            ENDIF
+
+            IF( tl_dim(4)%l_use )THEN
+               IF( ASSOCIATED(tl_time%d_value) )THEN
+                  ! add time
+                  CALL file_add_var(tl_fileout, tl_time)
+               ENDIF
+            ENDIF
+
+            ! add other variable
+            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))
+            ENDDO
+
+            ! add some attribute
+            tl_att=att_init("Created_by","SIREN create_boundary")
+            CALL file_add_att(tl_fileout, tl_att)
+
+            cl_date=date_print(date_now())
+            tl_att=att_init("Creation_date",cl_date)
+            CALL file_add_att(tl_fileout, tl_att)
+
+            ! add shift on north and east boundary
+            ! boundary compute on T point but express on U or V point
+            SELECT CASE(TRIM(tl_bdy(jl)%c_card))
+            CASE DEFAULT ! 'south','west'
+               il_shift=0
+            CASE('north','east')
+               il_shift=1
+            END SELECT
+
+            ! add indice of velocity row or column
+            tl_att=att_init('bdy_ind',tl_bdy(jl)%t_seg(jk)%i_index-il_shift)
+            CALL file_move_att(tl_fileout, tl_att)
+
+            ! add width of the relaxation zone
+            tl_att=att_init('bdy_width',tl_bdy(jl)%t_seg(jk)%i_width)
+            CALL file_move_att(tl_fileout, tl_att)
+            
+            ! add indice of segment start 
+            tl_att=att_init('bdy_deb',tl_bdy(jl)%t_seg(jk)%i_first)
+            CALL file_move_att(tl_fileout, tl_att)
+            
+            ! add indice of segment end 
+            tl_att=att_init('bdy_end',tl_bdy(jl)%t_seg(jk)%i_last)
+            CALL file_move_att(tl_fileout, tl_att)
+                           
+            ! clean
+            CALL att_clean(tl_att)
+
+            ! create file
+            CALL iom_create(tl_fileout)
+
+            ! write file
+            CALL iom_write_file(tl_fileout, cl_dimorder)
+
+            ! close file
+            CALL iom_close(tl_fileout)
+            CALL file_clean(tl_fileout)
+
+         ENDDO ! jk
+
+      ENDIF
+      ! clean
+      CALL boundary_clean(tl_bdy(jl))
+   ENDDO !jl
+
+   ! clean
+   IF( ASSOCIATED(tl_depth%d_value) ) CALL var_clean(tl_depth)
+   IF( ASSOCIATED(tl_time%d_value) ) CALL var_clean(tl_time)
+   DEALLOCATE( tl_segdom1 )
+   DEALLOCATE( tl_segvar1 )
+   CALL var_clean(tl_seglvl1(:,:,:))
+   DEALLOCATE( tl_seglvl1 )
+
+
+   CALL mpp_clean(tl_coord1)
+   CALL mpp_clean(tl_coord0)
+
+   CALL multi_clean(tl_multi)
+
+   ! close log file
+   CALL logger_footer()
+   CALL logger_close()
+   CALL logger_clean()
+
+END SUBROUTINE create__boundary
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute boundary domain for each grid point (T,U,V,F) 
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014
+   !> - take into account grid point to compute boundary indices
+   !>
+   !> @param[in] td_bathy1 file structure 
+   !> @param[in] td_bdy    boundary structure
+   !> @param[in] id_seg    segment indice 
+   !> @return array of domain structure 
+   !-------------------------------------------------------------------
+   FUNCTION create_boundary_get_dom( td_bathy1, td_bdy, id_seg )
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP) , INTENT(IN   ) :: td_bathy1
+      TYPE(TBDY) , INTENT(IN   ) :: td_bdy
+      INTEGER(i4), INTENT(IN   ) :: id_seg
+
+      ! function
+      TYPE(TDOM), DIMENSION(ip_npoint) :: create_boundary_get_dom
+
+      ! local variable
+      INTEGER(i4) :: il_imin1
+      INTEGER(i4) :: il_imax1
+      INTEGER(i4) :: il_jmin1
+      INTEGER(i4) :: il_jmax1
+
+      INTEGER(i4) :: il_imin
+      INTEGER(i4) :: il_imax
+      INTEGER(i4) :: il_jmin
+      INTEGER(i4) :: il_jmax
+
+      INTEGER(i4), DIMENSION(ip_npoint) :: il_ishift
+      INTEGER(i4), DIMENSION(ip_npoint) :: il_jshift
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+      ! init
+      jk=id_seg
+
+      il_ishift(:)=0
+      il_jshift(:)=0
+
+      ! get boundary definition
+      SELECT CASE(TRIM(td_bdy%c_card))
+         CASE('north')
+
+            il_imin1=td_bdy%t_seg(jk)%i_first
+            il_imax1=td_bdy%t_seg(jk)%i_last 
+            il_jmin1=td_bdy%t_seg(jk)%i_index-(td_bdy%t_seg(jk)%i_width-1)
+            il_jmax1=td_bdy%t_seg(jk)%i_index
+
+            il_jshift(jp_V)=-1
+            il_jshift(jp_F)=-1
+
+         CASE('south')
+
+            il_imin1=td_bdy%t_seg(jk)%i_first
+            il_imax1=td_bdy%t_seg(jk)%i_last 
+            il_jmin1=td_bdy%t_seg(jk)%i_index
+            il_jmax1=td_bdy%t_seg(jk)%i_index+(td_bdy%t_seg(jk)%i_width-1)
+
+         CASE('east')
+
+            il_imin1=td_bdy%t_seg(jk)%i_index-(td_bdy%t_seg(jk)%i_width-1)
+            il_imax1=td_bdy%t_seg(jk)%i_index
+            il_jmin1=td_bdy%t_seg(jk)%i_first
+            il_jmax1=td_bdy%t_seg(jk)%i_last 
+
+            il_ishift(jp_U)=-1
+            il_ishift(jp_F)=-1
+
+         CASE('west')
+
+            il_imin1=td_bdy%t_seg(jk)%i_index
+            il_imax1=td_bdy%t_seg(jk)%i_index+(td_bdy%t_seg(jk)%i_width-1)
+            il_jmin1=td_bdy%t_seg(jk)%i_first
+            il_jmax1=td_bdy%t_seg(jk)%i_last 
+
+      END SELECT         
+
+      !-read fine grid domain
+      DO ji=1,ip_npoint
+
+         ! shift domain
+         il_imin=il_imin1+il_ishift(ji)
+         il_imax=il_imax1+il_ishift(ji)
+
+         il_jmin=il_jmin1+il_jshift(ji)
+         il_jmax=il_jmax1+il_jshift(ji)
+
+         ! compute domain
+         create_boundary_get_dom(ji)=dom_init( td_bathy1,       &
+         &                                     il_imin, il_imax,&
+         &                                     il_jmin, il_jmax,&
+         &                                     TRIM(td_bdy%c_card) )
+
+      ENDDO
+
+   END FUNCTION create_boundary_get_dom
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine get coordinates over boundary domain
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014 
+   !> - take into account grid point
+   !>
+   !> @param[in] td_coord1 coordinates file structure
+   !> @param[in] td_dom1   boundary domain structure
+   !> @param[in] cd_point  grid point
+   !> @param[out] td_lon1  longitude variable structure
+   !> @param[out] td_lat1  latitude variable structure
+   !-------------------------------------------------------------------
+   SUBROUTINE create_boundary_get_coord( td_coord1, td_dom1, cd_point, &
+   &                                     td_lon1, td_lat1 )
+
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP)      , INTENT(IN   ) :: td_coord1
+      TYPE(TDOM)      , INTENT(IN   ) :: td_dom1
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_point
+      TYPE(TVAR)      , INTENT(  OUT) :: td_lon1
+      TYPE(TVAR)      , INTENT(  OUT) :: td_lat1 
+
+      ! local variable
+      TYPE(TMPP)        :: tl_coord1
+      
+      CHARACTER(LEN=lc) :: cl_name
+      ! loop indices
+      !----------------------------------------------------------------
+      !read variables on domain (ugly way to do it, have to work on it)
+      ! init mpp structure
+      tl_coord1=mpp_copy(td_coord1)
+      
+      ! open mpp files
+      CALL iom_dom_open(tl_coord1, td_dom1)
+
+      ! read variable value on domain
+      WRITE(cl_name,*) 'longitude_'//TRIM(cd_point)
+      td_lon1=iom_dom_read_var( tl_coord1, TRIM(cl_name), td_dom1)
+      WRITE(cl_name,*) 'latitude_'//TRIM(cd_point)
+      td_lat1=iom_dom_read_var( tl_coord1, TRIM(cl_name), td_dom1)
+
+      ! close mpp files
+      CALL iom_dom_close(tl_coord1)
+
+      ! clean structure
+      CALL mpp_clean(tl_coord1)
+
+   END SUBROUTINE create_boundary_get_coord
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine interpolate variable on boundary
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var variable structure 
+   !> @param[in] id_rho    array of refinment factor
+   !> @param[in] id_offset array of offset between fine and coarse grid
+   !> @param[in] id_iext   i-direction size of extra bands (default=im_minext)
+   !> @param[in] id_jext   j-direction size of extra bands (default=im_minext)
+   !-------------------------------------------------------------------
+   SUBROUTINE create_boundary_interp( td_var,           &
+   &                                  id_rho,           &
+   &                                  id_offset,        &
+   &                                  id_iext, id_jext )
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR) ,                 INTENT(INOUT) :: td_var
+      INTEGER(I4), DIMENSION(:)  , INTENT(IN   ) :: id_rho
+      INTEGER(i4), DIMENSION(:,:), INTENT(IN   ) :: id_offset
+
+      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_iext
+      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_jext
+
+
+      ! local variable
+      INTEGER(i4) :: il_iext
+      INTEGER(i4) :: il_jext
+      ! loop indices
+      !----------------------------------------------------------------
+
+      !WARNING: at least two extrabands are required for cubic interpolation
+      il_iext=2
+      IF( PRESENT(id_iext) ) il_iext=id_iext
+
+      il_jext=2
+      IF( PRESENT(id_jext) ) il_jext=id_jext
+
+      IF( il_iext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
+         CALL logger_warn("CREATE BOUNDARY INTERP: at least extrapolation "//&
+         &  "on two points are required with cubic interpolation ")
+         il_iext=2
+      ENDIF
+
+      IF( il_jext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
+         CALL logger_warn("CREATE BOUNDARY INTERP: at least extrapolation "//&
+         &  "on two points are required with cubic interpolation ")
+         il_jext=2
+      ENDIF
+
+      ! work on variable
+      ! add extraband
+      CALL extrap_add_extrabands(td_var, il_iext, il_jext)
+
+      ! extrapolate variable
+      CALL extrap_fill_value( td_var )
+
+      ! interpolate Bathymetry
+      CALL interp_fill_value( td_var, id_rho(:), &
+      &                       id_offset=id_offset(:,:) )
+
+      ! remove extraband
+      CALL extrap_del_extrabands(td_var, il_iext*id_rho(jp_I), &
+         &                               il_jext*id_rho(jp_J))
+
+   END SUBROUTINE create_boundary_interp
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function create variable, filled with matrix value
+   !> 
+   !> @details 
+   !> A variable is create with the same name that the input variable, 
+   !> and with dimension of the coordinate file. 
+   !> Then the variable array of value is split into equal subdomain.
+   !> Each subdomain is fill with the associated value of the matrix.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_var    variable structure 
+   !> @param[in] td_dom    domain structure 
+   !> @param[in] id_nlevel number of levels 
+   !> @return variable structure 
+   !-------------------------------------------------------------------
+   FUNCTION create_boundary_matrix(td_var, td_dom, id_nlevel)
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR) , INTENT(IN) :: td_var
+      TYPE(TDOM) , INTENT(IN) :: td_dom
+      INTEGER(i4), INTENT(IN) :: id_nlevel
+
+      ! function
+      TYPE(TVAR) :: create_boundary_matrix
+
+      ! local variable
+      INTEGER(i4)      , DIMENSION(3)                    :: il_dim
+      INTEGER(i4)      , DIMENSION(3)                    :: il_size
+      INTEGER(i4)      , DIMENSION(3)                    :: il_rest
+
+      INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_ishape
+      INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_jshape
+      INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_kshape
+
+      REAL(dp)         , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
+
+      TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      ! write value on grid
+      ! get matrix dimension
+      il_dim(:)=td_var%t_dim(1:3)%i_len
+
+      tl_dim(jp_I:jp_J)=dim_copy(td_dom%t_dim(jp_I:jp_J))
+      tl_dim(jp_K)%i_len=id_nlevel
+
+      ! split output domain in N subdomain depending of matrix dimension 
+      il_size(:) = tl_dim(1:3)%i_len / il_dim(:)
+      il_rest(:) = MOD(tl_dim(1:3)%i_len, il_dim(:))
+
+      ALLOCATE( il_ishape(il_dim(1)+1) )
+      il_ishape(:)=0
+      DO ji=2,il_dim(1)+1
+         il_ishape(ji)=il_ishape(ji-1)+il_size(1)
+      ENDDO
+      ! add rest to last cell
+      il_ishape(il_dim(1)+1)=il_ishape(il_dim(1)+1)+il_rest(1)
+      
+      ALLOCATE( il_jshape(il_dim(2)+1) )
+      il_jshape(:)=0
+      DO jj=2,il_dim(2)+1
+         il_jshape(jj)=il_jshape(jj-1)+il_size(2)
+      ENDDO
+      ! add rest to last cell
+      il_jshape(il_dim(2)+1)=il_jshape(il_dim(2)+1)+il_rest(2)
+
+      ALLOCATE( il_kshape(il_dim(3)+1) )
+      il_kshape(:)=0
+      DO jk=2,il_dim(3)+1
+         il_kshape(jk)=il_kshape(jk-1)+il_size(3)
+      ENDDO
+      ! add rest to last cell
+      il_kshape(il_dim(3)+1)=il_kshape(il_dim(3)+1)+il_rest(3)
+
+      ! write ouput array of value 
+      ALLOCATE(dl_value( tl_dim(1)%i_len, &
+      &                  tl_dim(2)%i_len, &
+      &                  tl_dim(3)%i_len, &
+      &                  tl_dim(4)%i_len) )
+
+      dl_value(:,:,:,:)=0
+
+      DO jk=2,il_dim(3)+1
+         DO jj=2,il_dim(2)+1
+            DO ji=2,il_dim(1)+1
+               
+               dl_value( 1+il_ishape(ji-1):il_ishape(ji), &
+               &         1+il_jshape(jj-1):il_jshape(jj), &
+               &         1+il_kshape(jk-1):il_kshape(jk), &
+               &         1 ) = td_var%d_value(ji-1,jj-1,jk-1,1)
+
+            ENDDO
+         ENDDO
+      ENDDO
+
+      ! initialise variable with value
+      create_boundary_matrix=var_init(TRIM(td_var%c_name),dl_value(:,:,:,:))
+
+      DEALLOCATE(dl_value)
+
+   END FUNCTION create_boundary_matrix
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine use mask to filled land point with _FillValue
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var variable structure 
+   !> @param[in] td_mask   mask variable structure
+   !-------------------------------------------------------------------
+   SUBROUTINE create_boundary_use_mask( td_var, td_mask )
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR), INTENT(INOUT) :: td_var
+      TYPE(TVAR), INTENT(IN   ) :: td_mask
+
+      ! local variable
+      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_mask
+
+      ! loop indices
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+
+      IF( ANY(td_var%t_dim(1:2)%i_len /= &
+      &       td_mask%t_dim(1:2)%i_len) )THEN
+         CALL logger_debug("     mask dimension ( "//&
+         &              TRIM(fct_str(td_mask%t_dim(1)%i_len))//","//&
+         &              TRIM(fct_str(td_mask%t_dim(2)%i_len))//")" )
+         CALL logger_debug(" variable dimension ( "//&
+         &              TRIM(fct_str(td_var%t_dim(1)%i_len))//","//&
+         &              TRIM(fct_str(td_var%t_dim(2)%i_len))//")" )
+         CALL logger_fatal("CREATE BOUNDARY USE MASK: mask and "//&
+         &                 "variable dimension differ."   )
+      ENDIF
+
+      ALLOCATE( il_mask(td_var%t_dim(1)%i_len, &
+      &                 td_var%t_dim(2)%i_len) )
+
+      il_mask(:,:)=INT(td_mask%d_value(:,:,1,1))
+
+      DO jl=1,td_var%t_dim(4)%i_len
+         DO jk=1,td_var%t_dim(3)%i_len
+            WHERE( il_mask(:,:) < jk ) td_var%d_value(:,:,jk,jl)=td_var%d_fill
+         ENDDO
+      ENDDO
+
+      DEALLOCATE( il_mask )
+
+   END SUBROUTINE create_boundary_use_mask
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function extract level over domain on each grid point, and return
+   !> array of variable structure
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_level  array of level variable structure
+   !> @param[in] td_dom    array of domain structure
+   !> @return array of variable structure
+   !-------------------------------------------------------------------
+   FUNCTION create_boundary_get_level(td_level, td_dom)
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR), DIMENSION(:), INTENT(IN) :: td_level
+      TYPE(TDOM), DIMENSION(:), INTENT(IN) :: td_dom
+
+      ! function
+      TYPE(TVAR), DIMENSION(ip_npoint) :: create_boundary_get_level
+
+      ! local variable
+      TYPE(TVAR), DIMENSION(ip_npoint) :: tl_var
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( SIZE(td_level(:)) /= ip_npoint .OR. &
+      &   SIZE(td_dom(:)) /= ip_npoint )THEN
+         CALL logger_error("CREATE BDY GET LEVEL: invalid dimension. "//&
+         &  "check input array of level and domain.")
+      ELSE
+
+         DO ji=1,ip_npoint
+
+            tl_var(ji)=var_copy(td_level(ji))
+
+            IF( ASSOCIATED(tl_var(ji)%d_value) ) DEALLOCATE(tl_var(ji)%d_value)
+
+            tl_var(ji)%t_dim(1)%i_len=td_dom(ji)%t_dim(1)%i_len
+            tl_var(ji)%t_dim(2)%i_len=td_dom(ji)%t_dim(2)%i_len
+            ALLOCATE(tl_var(ji)%d_value(tl_var(ji)%t_dim(1)%i_len, &
+            &                           tl_var(ji)%t_dim(2)%i_len, &
+            &                           tl_var(ji)%t_dim(3)%i_len, &
+            &                           tl_var(ji)%t_dim(4)%i_len) )
+
+            tl_var(ji)%d_value(:,:,:,:) = &
+            &  td_level(ji)%d_value( td_dom(ji)%i_imin:td_dom(ji)%i_imax, &
+            &                        td_dom(ji)%i_jmin:td_dom(ji)%i_jmax, :, : )
+
+         ENDDO
+         ! save result
+         create_boundary_get_level(:)=var_copy(tl_var(:))
+
+         ! clean
+         CALL var_clean(tl_var(:))
+
+      ENDIF
+   END FUNCTION create_boundary_get_level
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine check if variable need depth dimension, 
+   !> get depth variable value in an open mpp structure
+   !> and check if agree with already input depth variable.
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date November, 2014 - Initial Version
+   !> @date January, 2016
+   !> - check if variable need/use depth dimension
+   !>
+   !> @param[in] td_var       variable structure
+   !> @param[in] td_mpp       mpp structure
+   !> @param[in] id_nlevel    mpp structure
+   !> @param[inout] td_depth  depth variable structure 
+   !-------------------------------------------------------------------
+   SUBROUTINE create_boundary_check_depth( td_var, td_mpp, id_nlevel, td_depth )
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR) , INTENT(IN   ) :: td_var
+      TYPE(TMPP) , INTENT(IN   ) :: td_mpp
+      INTEGER(i4), INTENT(IN   ) :: id_nlevel
+      TYPE(TVAR) , INTENT(INOUT) :: td_depth
+
+      ! local variable
+      INTEGER(i4) :: il_varid
+      TYPE(TVAR)  :: tl_depth
+      ! loop indices
+      !----------------------------------------------------------------
+
+      IF( td_var%t_dim(jp_K)%l_use .AND. &
+      &   ( TRIM(td_var%c_axis) == '' .OR. &
+      &     INDEX(TRIM(td_var%c_axis),'Z') /= 0 )&
+      & )THEN
+
+         ! check vertical dimension
+         IF( td_mpp%t_dim(jp_K)%l_use )THEN
+            IF( td_mpp%t_dim(jp_K)%i_len /= id_nlevel .AND. &
+              & td_mpp%t_dim(jp_K)%i_len /= 1 )THEN
+               CALL logger_error("CREATE BOUNDARY: dimension in file "//&
+               &  TRIM(td_mpp%c_name)//" not agree with namelist in_nlevel ")
+            ENDIF
+         ENDIF
+
+         ! get or check depth value
+         IF( td_mpp%t_proc(1)%i_depthid /= 0 )THEN
+
+            il_varid=td_mpp%t_proc(1)%i_depthid
+            IF( ASSOCIATED(td_depth%d_value) )THEN
+
+               tl_depth=iom_mpp_read_var(td_mpp, il_varid)
+
+               IF( ANY( td_depth%d_value(:,:,:,:) /= &
+               &        tl_depth%d_value(:,:,:,:) ) )THEN
+
+                  CALL logger_error("CREATE BOUNDARY: depth value "//&
+                  &  "for variable "//TRIM(td_var%c_name)//&
+                  &  "from "//TRIM(td_mpp%c_name)//" not conform "//&
+                  &  " to those from former file(s).")
+
+               ENDIF
+               CALL var_clean(tl_depth)
+
+            ELSE
+               td_depth=iom_mpp_read_var(td_mpp,il_varid)
+            ENDIF
+
+         ENDIF
+      ELSE
+         CALL logger_debug("CREATE BOUNDARY: no depth dimension use"//&
+         &                 " for variable "//TRIM(td_var%c_name))
+      ENDIF
+      
+   END SUBROUTINE create_boundary_check_depth
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine check if variable need time dimension, 
+   !> get date and time in an open mpp structure
+   !> and check if agree with date and time already read.
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date November, 2014 - Initial Version
+   !> @date January, 2016
+   !> - check if variable need/use time dimension
+   !>
+   !> @param[in] td_var       variable structure
+   !> @param[in] td_mpp      mpp structure
+   !> @param[inout] td_time  time variable structure 
+   !-------------------------------------------------------------------
+   SUBROUTINE create_boundary_check_time( td_var, td_mpp, td_time )
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR), INTENT(IN   ) :: td_var
+      TYPE(TMPP), INTENT(IN   ) :: td_mpp
+      TYPE(TVAR), INTENT(INOUT) :: td_time
+
+      ! local variable
+      INTEGER(i4) :: il_varid
+      TYPE(TVAR)  :: tl_time
+
+      TYPE(TDATE) :: tl_date1
+      TYPE(TDATE) :: tl_date2
+      ! loop indices
+      !----------------------------------------------------------------
+      IF( td_var%t_dim(jp_L)%l_use .AND. &
+      &   ( TRIM(td_var%c_axis) == '' .OR. &
+      &     INDEX(TRIM(td_var%c_axis),'T') /= 0 )&
+      & )THEN
+
+         ! get or check depth value
+         IF( td_mpp%t_proc(1)%i_timeid /= 0 )THEN
+
+            il_varid=td_mpp%t_proc(1)%i_timeid
+            IF( ASSOCIATED(td_time%d_value) )THEN
+
+               tl_time=iom_mpp_read_var(td_mpp, il_varid)
+
+               tl_date1=var_to_date(td_time)
+               tl_date2=var_to_date(tl_time)
+               IF( tl_date1 - tl_date2 /= 0 )THEN
+
+                  CALL logger_warn("CREATE BOUNDARY: date from "//&
+                  &  TRIM(td_mpp%c_name)//" not conform "//&
+                  &  " to those from former file(s).")
+
+               ENDIF
+               CALL var_clean(tl_time)
+
+            ELSE
+               td_time=iom_mpp_read_var(td_mpp,il_varid)
+            ENDIF
+
+         ENDIF
+
+      ELSE
+         CALL logger_debug("CREATE BOUNDARY: no time dimension use"//&
+         &                 " for variable "//TRIM(td_var%c_name))
+      ENDIF
+
+   END SUBROUTINE create_boundary_check_time
+END PROGRAM create_boundary
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/create_boundary.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/create_boundary.f90	(revision 6439)
+++ 	(revision )
@@ -1,1638 +1,0 @@
-!----------------------------------------------------------------------
-! NEMO system team, System and Interface for oceanic RElocable Nesting
-!----------------------------------------------------------------------
-!
-!
-! PROGRAM: create_boundary
-!
-! DESCRIPTION:
-!> @file
-!> @brief 
-!> This program create boundary files.
-!>
-!> @details
-!> @section sec1 method
-!> Variables are read from coarse grid standard output 
-!> and interpolated on fine grid or manually written.<br/>
-!> @note 
-!>    method could be different for each variable.
-!>
-!> @section sec2 how to 
-!>    to create boundaries files:<br/>
-!> @code{.sh}
-!>    ./SIREN/bin/create_boundary create_boundary.nam
-!> @endcode
-!>    
-!>    create_boundary.nam comprise 9 namelists:<br/>
-!>       - logger namelist (namlog)
-!>       - config namelist (namcfg)
-!>       - coarse grid namelist (namcrs)
-!>       - fine grid namelist (namfin)
-!>       - variable namelist (namvar)
-!>       - nesting namelist (namnst)
-!>       - boundary namelist (nambdy)
-!>       - vertical grid namelist (namzgr)
-!>       - output namelist (namout)
-!>    
-!>    @note 
-!>       All namelists have to be in file create_boundary.nam, 
-!>       however variables of those namelists are all optional.
-!>
-!>    * _logger namelist (namlog)_:<br/>
-!>       - cn_logfile   : log filename
-!>       - cn_verbosity : verbosity ('trace','debug','info',
-!> 'warning','error','fatal')
-!>       - in_maxerror  : maximum number of error allowed
-!>
-!>    * _config namelist (namcfg)_:<br/>
-!>       - cn_varcfg : variable configuration file
-!> (see ./SIREN/cfg/variable.cfg)
-!>
-!>    * _coarse grid namelist (namcrs)_:<br/>
-!>       - cn_coord0 : coordinate file
-!>       - in_perio0 : NEMO periodicity index (see Model Boundary Condition in
-!> [NEMO documentation](http://www.nemo-ocean.eu/About-NEMO/Reference-manuals))
-!>
-!>    * _fine grid namelist (namfin)_:<br/>
-!>       - cn_coord1 : coordinate file
-!>       - cn_bathy1 : bathymetry file
-!>       - in_perio1 : periodicity index
-!>
-!>    * _vertical grid namelist (namzgr)_:<br/>
-!>       - 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
-!>
-!>    * _partial step namelist (namzps)_:<br/>
-!>       - dn_e3zps_mi           :
-!>       - dn_e3zps_rat          : 
-!>
-!>    * _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/>
-!>          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
-!>
-!>                requests must be separated by ';'.<br/>
-!>                order of requests does not matter.
-!>
-!>          informations about available method could be find in @ref interp,
-!>          @ref extrap and @ref filter.<br/>
-!>
-!>          Example: 'votemper:linear;hann;dist_weight', 'vosaline:cubic'
-!>          @note 
-!>             If you do not specify a method which is required, 
-!>             default one is apply.
-!>       - cn_varfile : list of variable, and corresponding file<br/> 
-!>          *cn_varfile* is the path and filename of the file where find
-!>          variable.<br/> 
-!>          @note 
-!>             *cn_varfile* could be a matrix of value, if you want to filled
-!>             manually variable value.<br/>
-!>             the variable array of value is split into equal subdomain.<br/>
-!>             Each subdomain is filled with the corresponding value 
-!>             of the matrix.<br/>          
-!>             separators used to defined matrix are:
-!>                - ',' for line
-!>                - '/' for row
-!>                - '\' for level<br/>
-!>                Example:<br/>
-!>                   3,2,3/1,4,5  =>  @f$ \left( \begin{array}{ccc}
-!>                                         3 & 2 & 3 \\
-!>                                         1 & 4 & 5 \end{array} \right) @f$
-!>          @warning 
-!>             the same matrix is used for all boundaries.
-!>
-!>       Examples: 
-!>          - 'votemper:gridT.nc', 'vozocrtx:gridU.nc'
-!>          - 'votemper:10\25', 'vozocrtx:gridU.nc'
-!>
-!>    * _nesting namelist (namnst)_:<br/>
-!>       - in_rhoi  : refinement factor in i-direction
-!>       - in_rhoj  : refinement factor in j-direction
-!>
-!>    * _boundary namelist (nambdy)_:<br/>
-!>       - ln_north  : use north boundary
-!>       - ln_south  : use south boundary
-!>       - ln_east   : use east  boundary
-!>       - ln_west   : use west  boundary
-!>       - cn_north  : north boundary indices on fine grid
-!>          *cn_north* is a string character defining boundary
-!>          segmentation.<br/>
-!>          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/>
-!>             - optionally, boundary size could be added between '(' and ')' 
-!>             in the first segment defined.
-!>                @note 
-!>                   boundary width is the same for all segments of one boundary.
-!>
-!>          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_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/>
-!>       - cn_fileout : fine grid boundary basename
-!>         (cardinal and segment number will be automatically added)
-!>
-!> @author J.Paul
-! REVISION HISTORY:
-!> @date November, 2013 - Initial Version
-!> @date September, 2014
-!> - add header for user
-!> - take into account grid point to compue boundaries
-!> - reorder output dimension for north and south boundaries 
-!>
-!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-!----------------------------------------------------------------------
-PROGRAM create_boundary
-
-   USE netcdf                          ! nf90 library
-   USE global                          ! global variable
-   USE phycst                          ! physical constant
-   USE kind                            ! F90 kind parameter
-   USE logger                          ! log file manager
-   USE fct                             ! basic useful function
-   USE date                            ! date manager
-   USE att                             ! attribute manager
-   USE dim                             ! dimension manager
-   USE var                             ! variable manager
-   USE file                            ! file manager
-   USE multi                           ! multi file manager
-   USE boundary                        ! boundary manager
-   USE iom                             ! I/O manager
-   USE dom                             ! domain manager
-   USE grid                            ! grid manager
-   USE vgrid                           ! vartical grid manager
-   USE extrap                          ! extrapolation manager
-   USE interp                          ! interpolation manager
-   USE filter                          ! filter manager
-   USE mpp                             ! MPP manager
-   USE iom_mpp                         ! MPP I/O manager
-
-   IMPLICIT NONE
-
-   ! local variable
-   CHARACTER(LEN=lc)                                  :: cl_namelist
-   CHARACTER(LEN=lc)                                  :: cl_date
-   CHARACTER(LEN=lc)                                  :: cl_name
-   CHARACTER(LEN=lc)                                  :: cl_bdyout
-   CHARACTER(LEN=lc)                                  :: cl_data
-   CHARACTER(LEN=lc)                                  :: cl_dimorder
-   CHARACTER(LEN=lc)                                  :: cl_point
-   CHARACTER(LEN=lc)                                  :: cl_fmt
-
-   INTEGER(i4)                                        :: il_narg
-   INTEGER(i4)                                        :: il_status
-   INTEGER(i4)                                        :: il_fileid
-   INTEGER(i4)                                        :: il_dim
-   INTEGER(i4)                                        :: il_imin0
-   INTEGER(i4)                                        :: il_imax0
-   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_offset
-   INTEGER(i4)      , DIMENSION(2,2)                  :: il_ind
-
-   LOGICAL                                            :: ll_exist
-
-   TYPE(TATT)                                         :: tl_att
-   
-   TYPE(TVAR)                                         :: tl_depth   
-   TYPE(TVAR)                                         :: tl_time
-   TYPE(TVAR)                                         :: tl_var1
-   TYPE(TVAR)                                         :: tl_var0
-   TYPE(TVAR)                                         :: tl_lon1
-   TYPE(TVAR)                                         :: tl_lat1
-   TYPE(TVAR)                                         :: tl_lvl1  
-   TYPE(TVAR)       , DIMENSION(:)      , ALLOCATABLE :: tl_level
-   TYPE(TVAR)       , DIMENSION(:,:,:)  , ALLOCATABLE :: tl_seglvl1
-   TYPE(TVAR)       , DIMENSION(:,:,:)  , ALLOCATABLE :: tl_segvar1
-
-   TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim
-   
-   TYPE(TBDY)       , DIMENSION(ip_ncard)             :: tl_bdy
-   
-   TYPE(TDOM)                                         :: tl_dom0
-   TYPE(TDOM)                                         :: tl_dom1
-   TYPE(TDOM)       , DIMENSION(:,:,:)  , ALLOCATABLE :: tl_segdom1
-
-   TYPE(TFILE)                                        :: tl_fileout
-   
-   TYPE(TMPP)                                         :: tl_coord0
-   TYPE(TMPP)                                         :: tl_coord1
-   TYPE(TMPP)                                         :: tl_bathy1
-   TYPE(TMPP)                                         :: tl_mpp
-
-   TYPE(TMULTI)                                       :: tl_multi
-
-   ! loop indices
-   INTEGER(i4) :: jvar
-   INTEGER(i4) :: jpoint
-   INTEGER(i4) :: ji
-   INTEGER(i4) :: jj
-   INTEGER(i4) :: jk
-   INTEGER(i4) :: jl
-
-   ! namelist variable
-   ! namlog
-   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' 
-
-   ! namcrs
-   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
-
-   !namzgr
-   INTEGER(i4)                             :: in_nlevel = 75
-
-   ! namvar
-   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = ''
-   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = ''
-
-   ! namnst
-   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
-
-   ! namout
-   CHARACTER(LEN=lc)                       :: cn_fileout = 'boundary.nc' 
-   !-------------------------------------------------------------------
-
-   NAMELIST /namlog/ &  !< logger namelist
-   &  cn_logfile,    &  !< log file
-   &  cn_verbosity,  &  !< log verbosity
-   &  in_maxerror
-
-   NAMELIST /namcfg/ &  !< config namelist
-   &  cn_varcfg         !< variable configuration file
-
-   NAMELIST /namcrs/ &  !< coarse grid namelist
-   &  cn_coord0,     &  !< coordinate file
-   &  in_perio0         !< periodicity index
-   
-   NAMELIST /namfin/ &  !< fine grid namelist
-   &  cn_coord1,     &  !< coordinate file
-   &  cn_bathy1,     &  !< bathymetry file
-   &  in_perio1         !< periodicity index
- 
-   NAMELIST /namzgr/ &
-   &  in_nlevel
-
-   NAMELIST /namvar/ &  !< variable namelist
-   &  cn_varinfo,    &  !< list of variable and method to apply on. (ex: 'votemper:linear','vosaline:cubic' )
-   &  cn_varfile        !< list of variable and file where find it. (ex: 'votemper:GLORYS_gridT.nc' ) 
-   
-   NAMELIST /namnst/ &  !< nesting namelist
-   &  in_rhoi,       &  !< refinement factor in i-direction
-   &  in_rhoj           !< refinement factor in j-direction
-
-   NAMELIST /nambdy/ &  !< boundary namelist
-   &  ln_north,      &  !< use north boundary
-   &  ln_south,      &  !< use south boundary
-   &  ln_east ,      &  !< use east  boundary
-   &  ln_west ,      &  !< use west  boundary
-   &  cn_north,      &  !< north boundary indices on fine grid
-   &  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
-
-   NAMELIST /namout/ &  !< output namelist
-   &  cn_fileout    !< fine grid boundary file basename   
-   !-------------------------------------------------------------------
-
-   ! namelist
-   ! get namelist
-   il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec
-   IF( il_narg/=1 )THEN
-      PRINT *,"CREATE BOUNDARY: ERROR. need a namelist"
-      STOP
-   ELSE
-      CALL GET_COMMAND_ARGUMENT(1,cl_namelist) !f03 intrinsec
-   ENDIF
-   
-   ! read namelist
-   INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist)
-   IF( ll_exist )THEN
-      
-      il_fileid=fct_getunit()
-
-      OPEN( il_fileid, FILE=TRIM(cl_namelist), &
-      &                FORM='FORMATTED',       &
-      &                ACCESS='SEQUENTIAL',    &
-      &                STATUS='OLD',           &
-      &                ACTION='READ',          &
-      &                IOSTAT=il_status)
-      CALL fct_err(il_status)
-      IF( il_status /= 0 )THEN
-         PRINT *,"CREATE BOUNDARY: ERROR opening "//TRIM(cl_namelist)
-         STOP
-      ENDIF
-
-      READ( il_fileid, NML = namlog )
-      ! define log file
-      CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror)
-      CALL logger_header()
-
-      READ( il_fileid, NML = namcfg )
-      ! get variable extra information
-      CALL var_def_extra(TRIM(cn_varcfg))
-
-      READ( il_fileid, NML = namcrs )
-      READ( il_fileid, NML = namfin )
-      READ( il_fileid, NML = namzgr )
-      READ( il_fileid, NML = namvar )
-      ! add user change in extra information
-      CALL var_chg_extra(cn_varinfo)
-      ! match variable with file
-      tl_multi=multi_init(cn_varfile)
-
-      READ( il_fileid, NML = namnst )
-      READ( il_fileid, NML = nambdy )
-      READ( il_fileid, NML = namout )
-
-      CLOSE( il_fileid, IOSTAT=il_status )
-      CALL fct_err(il_status)
-      IF( il_status /= 0 )THEN
-         CALL logger_error("CREATE BOUNDARY: ERROR closing "//TRIM(cl_namelist))
-      ENDIF
-
-   ELSE
-
-      PRINT *,"CREATE BOUNDARY: ERROR. can not find "//TRIM(cl_namelist)
-      STOP
-
-   ENDIF
-
-   CALL multi_print(tl_multi)
-   IF( tl_multi%i_nvar <= 0 )THEN
-      CALL logger_fatal("CREATE BOUNDARY: no variable to be used."//&
-      &  " check namelist.")
-   ENDIF
-
-   ! open files
-   IF( TRIM(cn_coord0) /= '' )THEN
-      tl_coord0=mpp_init( file_init(TRIM(cn_coord0)), id_perio=in_perio0)
-      CALL grid_get_info(tl_coord0)
-   ELSE
-      CALL logger_fatal("CREATE BOUNDARY: can not find coarse grid "//&
-      &  "coordinate file. check namelist")
-   ENDIF
-
-   IF( TRIM(cn_coord1) /= '' )THEN
-      tl_coord1=mpp_init( file_init(TRIM(cn_coord1)), id_perio=in_perio1)
-      CALL grid_get_info(tl_coord1)
-   ELSE
-      CALL logger_fatal("CREATE BOUNDARY: can not find fine grid coordinate "//&
-      &  "file. check namelist")
-   ENDIF
-
-   IF( TRIM(cn_bathy1) /= '' )THEN
-      tl_bathy1=mpp_init( file_init(TRIM(cn_bathy1)), id_perio=in_perio1)
-      CALL grid_get_info(tl_bathy1)
-   ELSE
-      CALL logger_fatal("CREATE BOUNDARY: can not find fine grid bathymetry "//&
-      &  "file. check namelist")
-   ENDIF
-
-   ! check
-   ! check output file do not already exist
-   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
-   ENDDO
-
-   ! check namelist
-   ! check refinement factor
-   il_rho(:)=1
-   IF( in_rhoi < 1 .OR. in_rhoj < 1 )THEN
-      CALL logger_error("CREATE BOUNDARY: invalid refinement factor."//&
-      &  " check namelist "//TRIM(cl_namelist))
-   ELSE
-      il_rho(jp_I)=in_rhoi
-      il_rho(jp_J)=in_rhoj
-   ENDIF
-
-   !
-   ! compute coarse grid indices around fine grid
-   il_ind(:,:)=grid_get_coarse_index(tl_coord0, tl_coord1, &
-   &                                 id_rho=il_rho(:))
-
-   il_imin0=il_ind(1,1) ; il_imax0=il_ind(1,2)
-   il_jmin0=il_ind(2,1) ; il_jmax0=il_ind(2,2)
-
-   ! check domain validity
-   CALL grid_check_dom(tl_coord0, il_imin0, il_imax0, il_jmin0, il_jmax0)
-
-   ! check coordinate file
-   CALL grid_check_coincidence( tl_coord0, tl_coord1, &
-   &                            il_imin0, il_imax0, &
-   &                            il_jmin0, il_jmax0, &
-   &                            il_rho(:) )      
-
-   ! read or compute boundary
-   CALL mpp_get_contour(tl_bathy1)
-
-   CALL iom_mpp_open(tl_bathy1)
-   
-   tl_var1=iom_mpp_read_var(tl_bathy1,'Bathymetry')
-   
-   CALL iom_mpp_close(tl_bathy1)
-
-   tl_bdy(:)=boundary_init(tl_var1, ln_north, ln_south, ln_east, ln_west, &
-   &                                cn_north, cn_south, cn_east, cn_west, &
-   &                                ln_oneseg ) 
-
-   CALL var_clean(tl_var1)
-
-   ! compute level
-   ALLOCATE(tl_level(ip_npoint))
-   tl_level(:)=vgrid_get_level(tl_bathy1, cl_namelist )
-
-   ! get coordinate on each segment of each boundary
-   ALLOCATE( tl_segdom1(ip_npoint,ip_maxseg,ip_ncard) )
-   ALLOCATE( tl_seglvl1(ip_npoint,ip_maxseg,ip_ncard) )
-   
-   DO jl=1,ip_ncard
-      IF( tl_bdy(jl)%l_use )THEN
-         DO jk=1,tl_bdy(jl)%i_nseg
-
-            ! get fine grid segment domain
-            tl_segdom1(:,jk,jl)=create_boundary_get_dom( tl_bathy1, &
-            &                                            tl_bdy(jl), jk )
-
-            ! add extra band to fine grid domain (if possible)
-            ! to avoid dimension of one and so be able to compute offset
-            DO jj=1,ip_npoint
-               CALL dom_add_extra(tl_segdom1(jj,jk,jl), &
-               &                  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
-      ENDIF
-   ENDDO
-
-   ! clean
-   CALL var_clean(tl_level(:))
-   DEALLOCATE(tl_level)
-
-   ! clean bathy
-   CALL mpp_clean(tl_bathy1)
-
-   ALLOCATE( tl_segvar1(tl_multi%i_nvar,ip_maxseg,ip_ncard) )
-   ! compute boundary for variable to be used (see namelist)
-   IF( .NOT. ASSOCIATED(tl_multi%t_mpp) )THEN
-      CALL logger_error("CREATE BOUNDARY: no file to work on. "//&
-      &                 "check cn_varfile in namelist.")
-   ELSE
-
-      jvar=0
-      ! for each file
-      DO ji=1,tl_multi%i_nmpp
-
-         WRITE(cl_data,'(a,i2.2)') 'data-',jvar+1
-
-         IF( .NOT. ASSOCIATED(tl_multi%t_mpp(ji)%t_proc(1)%t_var) )THEN
-
-            CALL logger_error("CREATE BOUNDARY: no variable to work on for "//&
-            &                 "mpp "//TRIM(tl_multi%t_mpp(ji)%c_name)//&
-            &                 ". check cn_varfile in namelist.")
-
-         ELSEIF( TRIM(tl_multi%t_mpp(ji)%c_name) == TRIM(cl_data) )THEN
-         !- use input matrix to fill variable
-
-            WRITE(*,'(a)') "work on data"
-            ! for each variable initialise from matrix
-            DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
-
-               jvar=jvar+1
-               WRITE(*,'(2x,a,a)') "work on variable "//&
-               &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name)
-
-               tl_var1=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj))
-
-               SELECT CASE(TRIM(tl_var1%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
-
-               WRITE(*,'(4x,a,a)') 'work on '//TRIM(tl_var1%c_name)
-               DO jl=1,ip_ncard
-                  IF( tl_bdy(jl)%l_use )THEN
-
-                     DO jk=1,tl_bdy(jl)%i_nseg
-
-                        ! fill value with matrix data
-                        tl_segvar1(jvar,jk,jl)=create_boundary_matrix( &
-                        &                          tl_var1, &
-                        &                          tl_segdom1(jpoint,jk,jl), &
-                        &                          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), &
-                        &                   tl_segdom1(jpoint,jk,jl) )
-
-                     ENDDO
-
-                  ENDIF
-               ENDDO
-               
-               ! clean
-               CALL var_clean(tl_var1)
-
-            ENDDO
-
-         !- end of use input matrix to fill variable
-         ELSE
-         !- use file to fill variable
-
-            WRITE(*,'(a)') "work on file "//TRIM(tl_multi%t_mpp(ji)%c_name)
-            ! 
-            tl_mpp=mpp_init(file_init(TRIM(tl_multi%t_mpp(ji)%t_proc(1)%c_name)))
-            CALL grid_get_info(tl_mpp)
-
-            ! check vertical dimension
-            IF( tl_mpp%t_dim(jp_K)%l_use .AND. &
-            &   tl_mpp%t_dim(jp_K)%i_len /= in_nlevel  )THEN
-               CALL logger_error("CREATE BOUNDARY: dimension in file "//&
-               &  TRIM(tl_mpp%c_name)//" not agree with namelist in_nlevel ")
-            ENDIF
-
-            ! open mpp file
-            CALL iom_mpp_open(tl_mpp)
-
-            ! get or check depth value
-            CALL create_boundary_check_depth( tl_mpp, tl_depth )
-
-            ! get or check time value
-            CALL create_boundary_check_time( tl_mpp, tl_time )
-
-            ! close mpp file
-            CALL iom_mpp_close(tl_mpp)
-
-            IF( ANY( tl_mpp%t_dim(1:2)%i_len /= &
-            &        tl_coord0%t_dim(1:2)%i_len) )THEN
-            !- extract value from fine grid
-
-               IF( ANY( tl_mpp%t_dim(1:2)%i_len <= &
-               &        tl_coord1%t_dim(1:2)%i_len) )THEN
-                  CALL logger_fatal("CREATE BOUNDARY: dimension in file "//&
-                  &  TRIM(tl_mpp%c_name)//" smaller than those in fine"//&
-                  &  " grid coordinates.")
-               ENDIF
-
-               DO jl=1,ip_ncard
-                  IF( tl_bdy(jl)%l_use )THEN
-                     
-                     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
-                        
-                        ! for each variable of this file
-                        DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
-                           
-                           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)
-
-                           cl_point=tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_point
-                           ! open mpp file on domain
-                           SELECT CASE(TRIM(cl_point))
-                              CASE DEFAULT !'T'
-                                 jpoint=jp_T
-                              CASE('U')
-                                 jpoint=jp_U
-                              CASE('V')
-                                 jpoint=jp_V
-                              CASE('F')
-                                 jpoint=jp_F
-                           END SELECT
-
-                           tl_dom1=dom_copy(tl_segdom1(jpoint,jk,jl))
-                           tl_lvl1=var_copy(tl_seglvl1(jpoint,jk,jl))
-
-                           ! open mpp files
-                           CALL iom_dom_open(tl_mpp, tl_dom1)
-
-                           !7-5 read variable over domain
-                           tl_segvar1(jvar+jj,jk,jl)=iom_dom_read_var( &
-                           &                     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), &
-                           &                   tl_dom1 )
-
-                           ! clean extra point information on fine grid domain
-                           CALL dom_clean_extra( tl_dom1 )
-
-                           ! add attribute to variable
-                           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/))
-                           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/))
-                           CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att)
-
-                           ! clean structure
-                           CALL att_clean(tl_att)
-                           CALL dom_clean(tl_dom1)
-
-                           ! close mpp files
-                           CALL iom_dom_close(tl_mpp)
-
-                           ! clean
-                           CALL var_clean(tl_lvl1)
-
-                        ENDDO ! jj
-                     ENDDO ! jk
-
-                  ENDIF
-               ENDDO ! jl
-
-               ! clean
-               CALL mpp_clean(tl_mpp)
-
-               jvar=jvar+tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
-
-            !- end of extract value from fine grid
-            ELSE
-            !- interpolate value from coarse grid
-
-               DO jl=1,ip_ncard
-                  IF( tl_bdy(jl)%l_use )THEN
-
-                     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 "//&
-                           &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name)
-
-                           tl_var0=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj))
-                           ! open mpp file on domain
-                           SELECT CASE(TRIM(tl_var0%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
-
-                           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, &
-                           &                               tl_var0%c_point,    &
-                           &                               tl_lon1, tl_lat1 )
-
-                           ! get coarse grid indices of this segment
-                           il_ind(:,:)=grid_get_coarse_index(tl_coord0, &
-                           &                                 tl_lon1, tl_lat1, &
-                           &                                 id_rho=il_rho(:) )
-
-                           IF( ANY(il_ind(:,:)==0) )THEN
-                              CALL logger_error("CREATE BOUNDARY: error "//&
-                              &  "computing coarse grid indices")
-                           ELSE
-                              il_imin0=il_ind(1,1)
-                              il_imax0=il_ind(1,2)
-
-                              il_jmin0=il_ind(2,1)
-                              il_jmax0=il_ind(2,2)
-                           ENDIF
-
-                           il_offset(:,:)= grid_get_fine_offset( &
-                           &                    tl_coord0, &
-                           &                    il_imin0, il_jmin0,&
-                           &                    il_imax0, il_jmax0,&
-                           &                    tl_lon1%d_value(:,:,1,1),&
-                           &                    tl_lat1%d_value(:,:,1,1),&
-                           &                    il_rho(:),&
-                           &                    TRIM(tl_var0%c_point) )
-
-                           ! compute coarse grid segment domain
-                           tl_dom0=dom_init( tl_coord0,         &
-                           &                 il_imin0, il_imax0,&
-                           &                 il_jmin0, il_jmax0 )
-
-                           ! add extra band (if possible) to compute interpolation
-                           CALL dom_add_extra(tl_dom0)
-
-                           ! read variables on domain 
-                           ! open mpp files
-                           CALL iom_dom_open(tl_mpp, tl_dom0)
-
-                           cl_name=tl_var0%c_name
-                           ! read variable value on domain
-                           tl_segvar1(jvar+jj,jk,jl)= &
-                           &    iom_dom_read_var(tl_mpp, TRIM(cl_name), tl_dom0)
-
-                           ! work on variable
-                           CALL create_boundary_interp( &
-                           &                 tl_segvar1(jvar+jj,jk,jl),&
-                           &                 il_rho(:), il_offset(:,:) )
-
-                           ! remove extraband added to domain
-                           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
-                           CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), &
-                           &                   tl_dom1 )
-                           ! clean extra point information on coarse grid domain
-                           CALL dom_clean_extra( tl_dom0 )
-
-                           ! add attribute to variable
-                           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)
-
-                           ! use clean extra avt creer attribut
-                           tl_att=att_init('src_i-indices',&
-                           &  (/tl_dom0%i_imin, tl_dom0%i_imax/))
-                           CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), &
-                           &                 tl_att)
-
-                           tl_att=att_init('src_j-indices', &
-                           &  (/tl_dom0%i_jmin, tl_dom0%i_jmax/))
-                           CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), &
-                           &                 tl_att)
-
-                           IF( ANY(il_rho(:)/=1) )THEN
-                              tl_att=att_init("refinment_factor", &
-                              &               (/il_rho(jp_I),il_rho(jp_J)/))
-                              CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), &
-                              &                 tl_att)
-                           ENDIF
-
-                           ! clean structure
-                           CALL att_clean(tl_att)
-
-                           ! clean
-                           CALL dom_clean(tl_dom0)
-                           CALL dom_clean(tl_dom1)
-
-                           ! close mpp files
-                           CALL iom_dom_close(tl_mpp)
-
-                           ! clean structure
-                           CALL var_clean(tl_lon1)
-                           CALL var_clean(tl_lat1)
-                           CALL var_clean(tl_lvl1)
-
-                        ENDDO ! jj
-
-                        ! clean
-                        CALL var_clean(tl_var0)
-
-                     ENDDO ! jk
-               
-                  ENDIF
-               ENDDO ! jl
-
-               jvar=jvar+tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
-
-            !- end of interpolate value from coarse grid
-            ENDIF
-
-            ! clean
-            CALL mpp_clean(tl_mpp)
-
-         !- end of use file to fill variable
-         ENDIF
-      ENDDO
-   ENDIF
-
-   IF( jvar /= tl_multi%i_nvar )THEN
-      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
-            !- 
-            CALL create_boundary_get_coord( tl_coord1, tl_segdom1(jp_T,jk,jl),&
-            &                               'T', tl_lon1, tl_lat1 )
-
-            ! del extra point on fine grid
-            CALL dom_del_extra( tl_lon1, tl_segdom1(jp_T,jk,jl) )
-            CALL dom_del_extra( tl_lat1, tl_segdom1(jp_T,jk,jl) )
-
-            ! clean
-            DO jpoint=1,ip_npoint
-               CALL dom_clean(tl_segdom1(jpoint,jk,jl))
-            ENDDO
-
-            ! swap array
-            CALL boundary_swap(tl_lon1, tl_bdy(jl))
-            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
-               ! forced min and max value
-               CALL var_limit_value(tl_segvar1(jvar,jk,jl))
-
-               ! filter
-               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 )
-
-            ENDDO
-
-            ! create file
-            ! 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) )
-            ELSE
-               cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
-               &                                TRIM(tl_bdy(jl)%c_card), jk )
-            ENDIF
-            ! 
-            tl_fileout=file_init(TRIM(cl_bdyout),id_perio=in_perio1)
-
-            ! add dimension
-            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
-
-            DO ji=1,ip_maxdim
-               IF( tl_dim(ji)%l_use ) CALL file_add_dim(tl_fileout, tl_dim(ji))
-            ENDDO
-
-            ! add variables
-            IF( ALL( tl_dim(1:2)%l_use ) )THEN
-               ! add longitude
-               CALL file_add_var(tl_fileout, tl_lon1)
-               CALL var_clean(tl_lon1)
-
-               ! add latitude
-               CALL file_add_var(tl_fileout, tl_lat1)
-               CALL var_clean(tl_lat1)
-            ENDIF
-            
-            IF( tl_dim(3)%l_use )THEN
-               ! add depth
-               CALL file_add_var(tl_fileout, tl_depth)
-            ENDIF
-
-            IF( tl_dim(4)%l_use )THEN
-               ! add time
-               CALL file_add_var(tl_fileout, tl_time)
-            ENDIF
-
-            ! add other variable
-            DO jvar=1,tl_multi%i_nvar
-               CALL file_add_var(tl_fileout, tl_segvar1(jvar,jk,jl))
-               CALL var_clean(tl_segvar1(jvar,jk,jl))
-            ENDDO
-
-            ! add some attribute
-            tl_att=att_init("Created_by","SIREN create_boundary")
-            CALL file_add_att(tl_fileout, tl_att)
-
-            cl_date=date_print(date_now())
-            tl_att=att_init("Creation_date",cl_date)
-            CALL file_add_att(tl_fileout, tl_att)
-
-            ! add shift on north and east boundary
-            ! boundary compute on T point but express on U or V point
-            SELECT CASE(TRIM(tl_bdy(jl)%c_card))
-            CASE DEFAULT ! 'south','west'
-               il_shift=0
-            CASE('north','east')
-               il_shift=1
-            END SELECT
-
-            ! add indice of velocity row or column
-            tl_att=att_init('bdy_ind',tl_bdy(jl)%t_seg(jk)%i_index-il_shift)
-            CALL file_move_att(tl_fileout, tl_att)
-
-            ! add width of the relaxation zone
-            tl_att=att_init('bdy_width',tl_bdy(jl)%t_seg(jk)%i_width)
-            CALL file_move_att(tl_fileout, tl_att)
-            
-            ! add indice of segment start 
-            tl_att=att_init('bdy_deb',tl_bdy(jl)%t_seg(jk)%i_first)
-            CALL file_move_att(tl_fileout, tl_att)
-            
-            ! add indice of segment end 
-            tl_att=att_init('bdy_end',tl_bdy(jl)%t_seg(jk)%i_last)
-            CALL file_move_att(tl_fileout, tl_att)
-                           
-            ! clean
-            CALL att_clean(tl_att)
-
-            ! create file
-            CALL iom_create(tl_fileout)
-
-            ! write file
-            CALL iom_write_file(tl_fileout)
-
-            ! close file
-            CALL iom_close(tl_fileout)
-            CALL file_clean(tl_fileout)
-
-         ENDDO ! jk
-
-      ENDIF
-      ! clean
-      CALL boundary_clean(tl_bdy(jl))
-   ENDDO !jl
-
-   ! clean
-   IF( ASSOCIATED(tl_depth%d_value) ) CALL var_clean(tl_depth)
-   IF( ASSOCIATED(tl_time%d_value) )   CALL var_clean(tl_time)
-   DEALLOCATE( tl_segdom1 )
-   DEALLOCATE( tl_segvar1 )
-
-   CALL mpp_clean(tl_coord1)
-   CALL mpp_clean(tl_coord0)
-
-   CALL multi_clean(tl_multi)
-
-   ! close log file
-   CALL logger_footer()
-   CALL logger_close()
-
-CONTAINS
-   !-------------------------------------------------------------------
-   !> @brief
-   !> This subroutine compute boundary domain for each grid point (T,U,V,F) 
-   !> 
-   !> @author J.Paul
-   !> - November, 2013- Initial Version
-   !> @date September, 2014
-   !> - take into account grid point to compute boundary indices
-   !>
-   !> @param[in] td_bathy1 file structure 
-   !> @param[in] td_bdy    boundary structure
-   !> @param[in] id_seg    segment indice 
-   !> @return array of domain structure 
-   !-------------------------------------------------------------------
-   FUNCTION create_boundary_get_dom( td_bathy1, td_bdy, id_seg )
-
-      IMPLICIT NONE
-
-      ! Argument
-      TYPE(TMPP) , INTENT(IN   ) :: td_bathy1
-      TYPE(TBDY) , INTENT(IN   ) :: td_bdy
-      INTEGER(i4), INTENT(IN   ) :: id_seg
-
-      ! function
-      TYPE(TDOM), DIMENSION(ip_npoint) :: create_boundary_get_dom
-
-      ! local variable
-      INTEGER(i4) :: il_imin1
-      INTEGER(i4) :: il_imax1
-      INTEGER(i4) :: il_jmin1
-      INTEGER(i4) :: il_jmax1
-
-      INTEGER(i4) :: il_imin
-      INTEGER(i4) :: il_imax
-      INTEGER(i4) :: il_jmin
-      INTEGER(i4) :: il_jmax
-
-      INTEGER(i4), DIMENSION(ip_npoint) :: il_ishift
-      INTEGER(i4), DIMENSION(ip_npoint) :: il_jshift
-
-      ! loop indices
-      INTEGER(i4) :: ji
-      INTEGER(i4) :: jk
-      !----------------------------------------------------------------
-      ! init
-      jk=id_seg
-
-      il_ishift(:)=0
-      il_jshift(:)=0
-
-      ! get boundary definition
-      SELECT CASE(TRIM(td_bdy%c_card))
-         CASE('north')
-
-            il_imin1=td_bdy%t_seg(jk)%i_first
-            il_imax1=td_bdy%t_seg(jk)%i_last 
-            il_jmin1=td_bdy%t_seg(jk)%i_index-(td_bdy%t_seg(jk)%i_width-1)
-            il_jmax1=td_bdy%t_seg(jk)%i_index
-
-            il_jshift(jp_V)=-1
-            il_jshift(jp_F)=-1
-
-         CASE('south')
-
-            il_imin1=td_bdy%t_seg(jk)%i_first
-            il_imax1=td_bdy%t_seg(jk)%i_last 
-            il_jmin1=td_bdy%t_seg(jk)%i_index
-            il_jmax1=td_bdy%t_seg(jk)%i_index+(td_bdy%t_seg(jk)%i_width-1)
-
-         CASE('east')
-
-            il_imin1=td_bdy%t_seg(jk)%i_index-(td_bdy%t_seg(jk)%i_width-1)
-            il_imax1=td_bdy%t_seg(jk)%i_index
-            il_jmin1=td_bdy%t_seg(jk)%i_first
-            il_jmax1=td_bdy%t_seg(jk)%i_last 
-
-            il_ishift(jp_U)=-1
-            il_ishift(jp_F)=-1
-
-         CASE('west')
-
-            il_imin1=td_bdy%t_seg(jk)%i_index
-            il_imax1=td_bdy%t_seg(jk)%i_index+(td_bdy%t_seg(jk)%i_width-1)
-            il_jmin1=td_bdy%t_seg(jk)%i_first
-            il_jmax1=td_bdy%t_seg(jk)%i_last 
-
-      END SELECT         
-
-      !-read fine grid domain
-      DO ji=1,ip_npoint
-
-         ! shift domain
-         il_imin=il_imin1+il_ishift(ji)
-         il_imax=il_imax1+il_ishift(ji)
-
-         il_jmin=il_jmin1+il_jshift(ji)
-         il_jmax=il_jmax1+il_jshift(ji)
-
-         ! compute domain
-         create_boundary_get_dom(ji)=dom_init( td_bathy1,       &
-         &                                     il_imin, il_imax,&
-         &                                     il_jmin, il_jmax,&
-         &                                     TRIM(td_bdy%c_card) )
-
-      ENDDO
-
-   END FUNCTION create_boundary_get_dom
-   !-------------------------------------------------------------------
-   !> @brief
-   !> This subroutine get coordinates over boudnary domain
-   !> 
-   !> @author J.Paul
-   !> - November, 2013- Initial Version
-   !> @date September, 2014 - take into account grid point
-   !>
-   !> @param[in] td_coord1 coordinates file structure
-   !> @param[in] td_dom1   boundary domain structure
-   !> @param[in] cd_point  grid point
-   !> @param[out] td_lon1  longitude variable structure
-   !> @param[out] td_lat1  latitude variable structure
-   !-------------------------------------------------------------------
-   SUBROUTINE create_boundary_get_coord( td_coord1, td_dom1, cd_point, &
-   &                                     td_lon1, td_lat1 )
-
-      IMPLICIT NONE
-      ! Argument
-      TYPE(TMPP)      , INTENT(IN   ) :: td_coord1
-      TYPE(TDOM)      , INTENT(IN   ) :: td_dom1
-      TYPE(TVAR)      , INTENT(  OUT) :: td_lon1
-      TYPE(TVAR)      , INTENT(  OUT) :: td_lat1 
-      CHARACTER(LEN=*), INTENT(IN   ), OPTIONAL :: cd_point
-
-      ! local variable
-      TYPE(TMPP)  :: tl_coord1
-      
-      CHARACTER(LEN=lc) :: cl_name
-      ! loop indices
-      !----------------------------------------------------------------
-      !read variables on domain (ugly way to do it, have to work on it)
-      ! init mpp structure
-      tl_coord1=mpp_copy(td_coord1)
-      
-      ! open mpp files
-      CALL iom_dom_open(tl_coord1, td_dom1)
-
-      ! read variable value on domain
-      WRITE(cl_name,*) 'longitude_'//TRIM(cd_point)
-      td_lon1=iom_dom_read_var( tl_coord1, TRIM(cl_name), td_dom1)
-      WRITE(cl_name,*) 'latitude_'//TRIM(cd_point)
-      td_lat1=iom_dom_read_var( tl_coord1, TRIM(cl_name), td_dom1)
-
-      ! close mpp files
-      CALL iom_dom_close(tl_coord1)
-
-      ! clean structure
-      CALL mpp_clean(tl_coord1)
-
-   END SUBROUTINE create_boundary_get_coord
-   !-------------------------------------------------------------------
-   !> @brief
-   !> This subroutine interpolate variable over boundary
-   !> 
-   !> @details 
-   !>
-   !> @author J.Paul
-   !> - Nov, 2013- Initial Version
-   !>
-   !> @param[inout] td_var variable structure 
-   !> @param[in] id_rho    array of refinment factor
-   !> @param[in] id_offset array of offset between fine and coarse grid
-   !> @param[in] id_iext   i-direction size of extra bands (default=im_minext)
-   !> @param[in] id_jext   j-direction size of extra bands (default=im_minext)
-   !-------------------------------------------------------------------
-   SUBROUTINE create_boundary_interp( td_var,           &
-   &                                  id_rho,           &
-   &                                  id_offset,        &
-   &                                  id_iext, id_jext )
-
-      IMPLICIT NONE
-
-      ! Argument
-      TYPE(TVAR) ,                 INTENT(INOUT) :: td_var
-      INTEGER(I4), DIMENSION(:)  , INTENT(IN   ) :: id_rho
-      INTEGER(i4), DIMENSION(:,:), INTENT(IN   ) :: id_offset
-
-      INTEGER(i4), INTENT(IN   ), OPTIONAL :: id_iext
-      INTEGER(i4), INTENT(IN   ), OPTIONAL :: id_jext
-
-
-      ! local variable
-      INTEGER(i4) :: il_iext
-      INTEGER(i4) :: il_jext
-      ! loop indices
-      !----------------------------------------------------------------
-
-      !WARNING: at least two extrabands are required for cubic interpolation
-      il_iext=2
-      IF( PRESENT(id_iext) ) il_iext=id_iext
-
-      il_jext=2
-      IF( PRESENT(id_jext) ) il_jext=id_jext
-
-      IF( il_iext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
-         CALL logger_warn("CREATE BOUNDARY INTERP: at least extrapolation "//&
-         &  "on two points are required with cubic interpolation ")
-         il_iext=2
-      ENDIF
-
-      IF( il_jext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
-         CALL logger_warn("CREATE BOUNDARY INTERP: at least extrapolation "//&
-         &  "on two points are required with cubic interpolation ")
-         il_jext=2
-      ENDIF
-
-      ! work on variable
-      ! add extraband
-      CALL extrap_add_extrabands(td_var, il_iext, il_jext)
-
-      ! extrapolate variable
-      CALL extrap_fill_value( td_var, id_iext=il_iext, id_jext=il_jext )
-
-      ! interpolate Bathymetry
-      CALL interp_fill_value( td_var, id_rho(:), &
-      &                       id_offset=id_offset(:,:) )
-
-      ! remove extraband
-      CALL extrap_del_extrabands(td_var, il_iext*id_rho(jp_I), il_jext*id_rho(jp_J))
-
-   END SUBROUTINE create_boundary_interp
-   !-------------------------------------------------------------------
-   !> @brief
-   !> This function create variable, filled with matrix value
-   !> 
-   !> @details 
-   !> A variable is create with the same name that the input variable, 
-   !> and with dimension of the coordinate file. 
-   !> Then the variable array of value is split into equal subdomain.
-   !> Each subdomain is fill with the linked value of the matrix.
-   !>
-   !> @author J.Paul
-   !> - November, 2013- Initial Version
-   !>
-   !> @param[in] td_var    variable structure 
-   !> @param[in] td_dom    domain structure 
-   !> @param[in] id_nlevel number of levels 
-   !> @return variable structure 
-   !-------------------------------------------------------------------
-   FUNCTION create_boundary_matrix(td_var, td_dom, id_nlevel)
-      IMPLICIT NONE
-      ! Argument
-      TYPE(TVAR) ,               INTENT(IN) :: td_var
-      TYPE(TDOM) ,               INTENT(IN) :: td_dom
-      INTEGER(i4),               INTENT(IN) :: id_nlevel
-
-      ! function
-      TYPE(TVAR) :: create_boundary_matrix
-
-      ! local variable
-      INTEGER(i4)      , DIMENSION(3)                    :: il_dim
-      INTEGER(i4)      , DIMENSION(3)                    :: il_size
-      INTEGER(i4)      , DIMENSION(3)                    :: il_rest
-
-      INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_ishape
-      INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_jshape
-      INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_kshape
-
-      REAL(dp)         , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
-
-      TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim
-
-      ! loop indices
-      INTEGER(i4) :: ji
-      INTEGER(i4) :: jj
-      INTEGER(i4) :: jk
-      !----------------------------------------------------------------
-
-      ! write value on grid
-      ! get matrix dimension
-      il_dim(:)=td_var%t_dim(1:3)%i_len
-
-      tl_dim(jp_I:jp_J)=dim_copy(td_dom%t_dim(jp_I:jp_J))
-      tl_dim(jp_K)%i_len=id_nlevel
-
-      ! split output domain in N subdomain depending of matrix dimension 
-      il_size(:) = tl_dim(1:3)%i_len / il_dim(:)
-      il_rest(:) = MOD(tl_dim(1:3)%i_len, il_dim(:))
-
-      ALLOCATE( il_ishape(il_dim(1)+1) )
-      il_ishape(:)=0
-      DO ji=2,il_dim(1)+1
-         il_ishape(ji)=il_ishape(ji-1)+il_size(1)
-      ENDDO
-      ! add rest to last cell
-      il_ishape(il_dim(1)+1)=il_ishape(il_dim(1)+1)+il_rest(1)
-      
-      ALLOCATE( il_jshape(il_dim(2)+1) )
-      il_jshape(:)=0
-      DO jj=2,il_dim(2)+1
-         il_jshape(jj)=il_jshape(jj-1)+il_size(2)
-      ENDDO
-      ! add rest to last cell
-      il_jshape(il_dim(2)+1)=il_jshape(il_dim(2)+1)+il_rest(2)
-
-      ALLOCATE( il_kshape(il_dim(3)+1) )
-      il_kshape(:)=0
-      DO jk=2,il_dim(3)+1
-         il_kshape(jk)=il_kshape(jk-1)+il_size(3)
-      ENDDO
-      ! add rest to last cell
-      il_kshape(il_dim(3)+1)=il_kshape(il_dim(3)+1)+il_rest(3)
-
-      ! write ouput array of value 
-      ALLOCATE(dl_value( tl_dim(1)%i_len, &
-      &                  tl_dim(2)%i_len, &
-      &                  tl_dim(3)%i_len, &
-      &                  tl_dim(4)%i_len) )
-
-      dl_value(:,:,:,:)=0
-
-      DO jk=2,il_dim(3)+1
-         DO jj=2,il_dim(2)+1
-            DO ji=2,il_dim(1)+1
-               
-               dl_value( 1+il_ishape(ji-1):il_ishape(ji), &
-               &         1+il_jshape(jj-1):il_jshape(jj), &
-               &         1+il_kshape(jk-1):il_kshape(jk), &
-               &         1 ) = td_var%d_value(ji-1,jj-1,jk-1,1)
-
-            ENDDO
-         ENDDO
-      ENDDO
-
-      ! initialise variable with value
-      create_boundary_matrix=var_init(TRIM(td_var%c_name),dl_value(:,:,:,:))
-
-      DEALLOCATE(dl_value)
-
-   END FUNCTION create_boundary_matrix
-   !-------------------------------------------------------------------
-   !> @brief
-   !> This subroutine use mask to filled land point with _FillValue
-   !> 
-   !> @details 
-   !>
-   !> @author J.Paul
-   !> - November, 2013- Initial Version
-   !>
-   !> @param[inout] td_var variable structure 
-   !> @param[in] td_mask   mask variable structure
-   !-------------------------------------------------------------------
-   SUBROUTINE create_boundary_use_mask( td_var, td_mask )
-
-      IMPLICIT NONE
-
-      ! Argument
-      TYPE(TVAR), INTENT(INOUT) :: td_var
-      TYPE(TVAR), INTENT(IN   ) :: td_mask
-
-      ! local variable
-      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_mask
-
-      ! loop indices
-      INTEGER(i4) :: jk
-      INTEGER(i4) :: jl
-      !----------------------------------------------------------------
-
-      IF( ANY(td_var%t_dim(1:2)%i_len /= &
-      &       td_mask%t_dim(1:2)%i_len) )THEN
-         CALL logger_debug("     mask dimension ( "//&
-         &              TRIM(fct_str(td_mask%t_dim(1)%i_len))//","//&
-         &              TRIM(fct_str(td_mask%t_dim(2)%i_len))//")" )
-         CALL logger_debug(" variable dimension ( "//&
-         &              TRIM(fct_str(td_var%t_dim(1)%i_len))//","//&
-         &              TRIM(fct_str(td_var%t_dim(2)%i_len))//")" )
-         CALL logger_fatal("CREATE BOUNDARY USE MASK: mask and "//&
-         &                 "variable dimension differ."   )
-      ENDIF
-
-      ALLOCATE( il_mask(td_var%t_dim(1)%i_len, &
-      &                 td_var%t_dim(2)%i_len) )
-
-      il_mask(:,:)=INT(td_mask%d_value(:,:,1,1))
-
-      DO jl=1,td_var%t_dim(4)%i_len
-         DO jk=1,td_var%t_dim(3)%i_len
-            WHERE( il_mask(:,:) < jk ) td_var%d_value(:,:,jk,jl)=td_var%d_fill
-         ENDDO
-      ENDDO
-
-      DEALLOCATE( il_mask )
-
-   END SUBROUTINE create_boundary_use_mask
-   !-------------------------------------------------------------------
-   !> @brief
-   !> This function extract level over domain on each grid point, and return
-   !> array of variable structure
-   !>
-   !> @author J.Paul
-   !> - November, 2013- Initial Version
-   !>
-   !> @param[in] td_level  array of level variable structure
-   !> @param[in] td_dom    array of domain structure
-   !> @return array of variable structure
-   !-------------------------------------------------------------------
-   FUNCTION create_boundary_get_level(td_level, td_dom)
-      IMPLICIT NONE
-      ! Argument
-      TYPE(TVAR), DIMENSION(:), INTENT(IN) :: td_level
-      TYPE(TDOM), DIMENSION(:), INTENT(IN) :: td_dom
-
-      ! function
-      TYPE(TVAR), DIMENSION(ip_npoint) :: create_boundary_get_level
-
-      ! local variable
-      TYPE(TVAR), DIMENSION(ip_npoint) :: tl_var
-
-      ! loop indices
-      INTEGER(i4) :: ji
-      !----------------------------------------------------------------
-
-      IF( SIZE(td_level(:)) /= ip_npoint .OR. &
-      &   SIZE(td_dom(:)) /= ip_npoint )THEN
-         CALL logger_error("CREATE BDY GET LEVEL: invalid dimension. "//&
-         &  "check input array of level and domain.")
-      ELSE
-
-         DO ji=1,ip_npoint
-
-            tl_var(ji)=var_copy(td_level(ji))
-
-            IF( ASSOCIATED(tl_var(ji)%d_value) ) DEALLOCATE(tl_var(ji)%d_value)
-
-            tl_var(ji)%t_dim(1)%i_len=td_dom(ji)%t_dim(1)%i_len
-            tl_var(ji)%t_dim(2)%i_len=td_dom(ji)%t_dim(2)%i_len
-            ALLOCATE(tl_var(ji)%d_value(tl_var(ji)%t_dim(1)%i_len, &
-            &                           tl_var(ji)%t_dim(2)%i_len, &
-            &                           tl_var(ji)%t_dim(3)%i_len, &
-            &                           tl_var(ji)%t_dim(4)%i_len) )
-
-            tl_var(ji)%d_value(:,:,:,:) = &
-            &  td_level(ji)%d_value( td_dom(ji)%i_imin:td_dom(ji)%i_imax, &
-            &                        td_dom(ji)%i_jmin:td_dom(ji)%i_jmax, :, : )
-
-         ENDDO
-         ! save result
-         create_boundary_get_level(:)=var_copy(tl_var(:))
-
-         ! clean
-         CALL var_clean(tl_var(:))
-
-      ENDIF
-   END FUNCTION create_boundary_get_level
-   !-------------------------------------------------------------------
-   !> @brief
-   !> This subroutine get depth variable value in an open mpp structure
-   !> and check if agree with already input depth variable.
-   !> 
-   !> @details 
-   !>
-   !> @author J.Paul
-   !> - November, 2014- Initial Version
-   !>
-   !> @param[in] td_mpp       mpp structure
-   !> @param[inout] td_depth  depth variable structure 
-   !-------------------------------------------------------------------
-   SUBROUTINE create_boundary_check_depth( td_mpp, td_depth )
-
-      IMPLICIT NONE
-
-      ! Argument
-      TYPE(TMPP) , INTENT(IN   ) :: td_mpp
-      TYPE(TVAR) , INTENT(INOUT) :: td_depth
-
-      ! local variable
-      INTEGER(i4) :: il_varid
-      TYPE(TVAR)  :: tl_depth
-      ! loop indices
-      !----------------------------------------------------------------
-
-      ! get or check depth value
-      IF( td_mpp%t_proc(1)%i_depthid /= 0 )THEN
-
-         il_varid=td_mpp%t_proc(1)%i_depthid
-         IF( ASSOCIATED(td_depth%d_value) )THEN
-
-            tl_depth=iom_mpp_read_var(td_mpp, il_varid)
-            IF( ANY( td_depth%d_value(:,:,:,:) /= &
-            &        tl_depth%d_value(:,:,:,:) ) )THEN
-
-               CALL logger_fatal("CREATE BOUNDARY: depth value from "//&
-               &  TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//&
-               &  " to those from former file(s).")
-
-            ENDIF
-            CALL var_clean(tl_depth)
-
-         ELSE
-            td_depth=iom_mpp_read_var(td_mpp,il_varid)
-         ENDIF
-
-      ENDIF
-      
-   END SUBROUTINE create_boundary_check_depth
-   !-------------------------------------------------------------------
-   !> @brief
-   !> This subroutine get date and time in an open mpp structure
-   !> and check if agree with date and time already read.
-   !> 
-   !> @details 
-   !>
-   !> @author J.Paul
-   !> - November, 2014- Initial Version
-   !>
-   !> @param[in] td_mpp      mpp structure
-   !> @param[inout] td_time  time variable structure 
-   !-------------------------------------------------------------------
-   SUBROUTINE create_boundary_check_time( td_mpp, td_time )
-
-      IMPLICIT NONE
-
-      ! Argument
-      TYPE(TMPP), INTENT(IN   ) :: td_mpp
-      TYPE(TVAR), INTENT(INOUT) :: td_time
-
-      ! local variable
-      INTEGER(i4) :: il_varid
-      TYPE(TVAR)  :: tl_time
-
-      TYPE(TDATE) :: tl_date1
-      TYPE(TDATE) :: tl_date2
-      ! loop indices
-      !----------------------------------------------------------------
-
-      ! get or check depth value
-      IF( td_mpp%t_proc(1)%i_timeid /= 0 )THEN
-
-         il_varid=td_mpp%t_proc(1)%i_timeid
-         IF( ASSOCIATED(td_time%d_value) )THEN
-
-            tl_time=iom_mpp_read_var(td_mpp, il_varid)
-
-            tl_date1=var_to_date(td_time)
-            tl_date2=var_to_date(tl_time)
-            IF( tl_date1 - tl_date2 /= 0 )THEN
-
-               CALL logger_fatal("CREATE BOUNDARY: date from "//&
-               &  TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//&
-               &  " to those from former file(s).")
-
-            ENDIF
-            CALL var_clean(tl_time)
-
-         ELSE
-            td_time=iom_mpp_read_var(td_mpp,il_varid)
-         ENDIF
-
-      ENDIF
-      
-   END SUBROUTINE create_boundary_check_time
-END PROGRAM create_boundary
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/create_coord.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/create_coord.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/create_coord.f90	(revision 6440)
@@ -9,5 +9,5 @@
 !> @file
 !> @brief 
-!> This program create fine grid coordinate file.
+!> This program creates fine grid coordinate file.
 !>
 !> @details
@@ -24,5 +24,8 @@
 !> @endcode
 !>    
-!>    create_coord.nam comprise 6 namelists:<br/>
+!> @note 
+!>    you could find a template of the namelist in templates directory.
+!>
+!>    create_coord.nam contains 6 namelists:<br/>
 !>       - logger namelist (namlog)
 !>       - config namelist (namcfg)
@@ -32,12 +35,8 @@
 !>       - output namelist (namout)
 !>    
-!>    @note 
-!>       All namelists have to be in file create_coord.nam, 
-!>       however variables of those namelists are all optional.
-!>
 !>    * _logger namelist (namlog)_:<br/>
 !>       - cn_logfile   : log filename
 !>       - cn_verbosity : verbosity ('trace','debug','info',
-!> 'warning','error','fatal')
+!> 'warning','error','fatal','none')
 !>       - in_maxerror  : maximum number of error allowed
 !>
@@ -45,4 +44,6 @@
 !>       - cn_varcfg : variable configuration file 
 !> (see ./SIREN/cfg/variable.cfg)
+!>       - cn_dumcfg : useless (dummy) configuration file, for useless 
+!> dimension or variable (see ./SIREN/cfg/dummy.cfg).
 !>
 !>    * _coarse grid namelist (namcrs)_:<br/>
@@ -54,11 +55,11 @@
 !>       - cn_varinfo : list of variable and extra information about request(s)
 !> to be used.<br/>
-!>          each elements of *cn_varinfo* is a string character.<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
 !> 
 !>                requests must be separated by ';' .<br/>
@@ -68,6 +69,6 @@
 !>          @ref extrap and @ref filter modules.<br/>
 !>
-!>          Example: 'votemper: linear; hann(2,3); dist_weight', 
-!>          'vosaline: cubic'<br/>
+!>          Example: 'glamt: int=linear; ext=dist_weight', 
+!>          'e1t: int=cubic/rhoi'<br/>
 !>          @note 
 !>             If you do not specify a method which is required, 
@@ -90,5 +91,5 @@
 !>
 !>    * _output namelist (namout)_:
-!>       - cn_fileout : output coordinate file
+!>       - cn_fileout : output coordinate file name
 !>
 !> @author J.Paul
@@ -99,4 +100,6 @@
 !> - compute offset considering grid point
 !> - add global attributes in output file
+!> @date September, 2015
+!> - manage useless (dummy) variable, attributes, and dimension
 !>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -152,12 +155,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 +160,21 @@
 
    ! 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' 
+   CHARACTER(LEN=lc) :: cn_dumcfg = './cfg/dummy.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'
    !-------------------------------------------------------------------
@@ -192,5 +194,6 @@
 
    NAMELIST /namcfg/ &  !  config namelist
-   &  cn_varcfg         !< variable configuration file
+   &  cn_varcfg, &       !< variable configuration file
+   &  cn_dumcfg          !< dummy configuration file
 
    NAMELIST /namcrs/ &  !  coarse grid namelist
@@ -252,4 +255,11 @@
       CALL var_def_extra(TRIM(cn_varcfg))
 
+      ! get dummy variable
+      CALL var_get_dummy(TRIM(cn_dumcfg))
+      ! get dummy dimension
+      CALL dim_get_dummy(TRIM(cn_dumcfg))
+      ! get dummy attribute
+      CALL att_get_dummy(TRIM(cn_dumcfg))
+
       READ( il_fileid, NML = namcrs )
       READ( il_fileid, NML = namvar )
@@ -305,5 +315,4 @@
 
       il_offset(:,:,:)=create_coord_get_offset(il_rho(:))
-
    ENDIF
 
@@ -348,12 +357,11 @@
       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))      
 
    ENDDO
+
+   ! clean
+   CALL dom_clean_extra( tl_dom )
 
    ! close mpp files
@@ -375,9 +383,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
@@ -392,7 +399,7 @@
    CALL file_add_att(tl_fileout, tl_att)   
 
-   tl_att=att_init("src_i_indices",(/in_imin0,in_imax0/))
+   tl_att=att_init("src_i_indices",(/tl_dom%i_imin,tl_dom%i_imax/))
    CALL file_add_att(tl_fileout, tl_att)   
-   tl_att=att_init("src_j_indices",(/in_jmin0,in_jmax0/))
+   tl_att=att_init("src_j_indices",(/tl_dom%i_jmin,tl_dom%i_jmax/))
    CALL file_add_att(tl_fileout, tl_att)
    IF( .NOT. ALL(il_rho(:)==1) )THEN
@@ -440,37 +447,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 +513,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 +602,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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/create_restart.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/create_restart.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/create_restart.f90	(revision 6440)
@@ -9,11 +9,11 @@
 !> @file
 !> @brief 
-!> This program create restart file.
+!> This program creates restart file.
 !>
 !> @details
 !> @section sec1 method
 !> Variables could be extracted from fine grid file, interpolated from coarse
-!> grid file or restart file, or manually written.<br/> 
-!> Then they are split over new decomposition. 
+!> grid file or restart file. Variables could also be manually written.<br/> 
+!> Then they are split over new layout. 
 !> @note 
 !>    method could be different for each variable.
@@ -25,5 +25,8 @@
 !> @endcode
 !>    
-!>    create_restart.nam comprise 9 namelists:<br/>
+!> @note 
+!>    you could find a template of the namelist in templates directory.
+!>
+!>    create_restart.nam contains 9 namelists:<br/>
 !>       - logger namelist (namlog)
 !>       - config namelist (namcfg)
@@ -36,12 +39,8 @@
 !>       - output namelist (namout)
 !>    
-!>    @note 
-!>       All namelists have to be in file create_restart.nam 
-!>       however variables of those namelists are all optional.
-!>
 !>    * _logger namelist (namlog)_:<br/>
 !>       - cn_logfile   : log filename
 !>       - cn_verbosity : verbosity ('trace','debug','info',
-!> 'warning','error','fatal')
+!> 'warning','error','fatal','none')
 !>       - in_maxerror  : maximum number of error allowed
 !>
@@ -49,4 +48,6 @@
 !>       - cn_varcfg : variable configuration file
 !> (see ./SIREN/cfg/variable.cfg)
+!>       - cn_dumcfg : useless (dummy) configuration file, for useless 
+!> dimension or variable (see ./SIREN/cfg/dummy.cfg).
 !>
 !>    * _coarse grid namelist (namcrs):<br/>
@@ -59,6 +60,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/>
@@ -81,26 +80,5 @@
 !>
 !>    * _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/>
-!>          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
-!>
-!>             requests must be separated by ';'.<br/>
-!>             order of requests does not matter.<br/>
-!>
-!>          informations about available method could be find in @ref interp,
-!>          @ref extrap and @ref filter.<br/>
-!>          Example: 'votemper: linear; hann; dist_weight','vosaline: cubic'
-!>          @note 
-!>             If you do not specify a method which is required, 
-!>             default one is apply.
-!>       - cn_varfile : list of variable, and corresponding file<br/> 
+!>       - cn_varfile : list of variable, and associated file<br/> 
 !>          *cn_varfile* is the path and filename of the file where find
 !>          variable.<br/>
@@ -127,16 +105,43 @@
 !>             - 'all:restart.dimg'
 !>
+!>       - cn_varinfo : list of variable and extra information about request(s) 
+!>       to be used.<br/>
+!>          each elements of *cn_varinfo* is a string character
+!>          (separated by ',').<br/>
+!>          it is composed of the variable name follow by ':', 
+!>          then request(s) to be used on this variable.<br/> 
+!>          request could be:
+!>             - int = interpolation method
+!>             - ext = extrapolation method
+!>             - flt = filter method
+!>             - min = minimum value
+!>             - max = maximum value
+!>             - unt = new units
+!>             - unf = unit scale factor (linked to new units)
+!>
+!>             requests must be separated by ';'.<br/>
+!>             order of requests does not matter.<br/>
+!>
+!>          informations about available method could be find in @ref interp,
+!>          @ref extrap and @ref filter.<br/>
+!>          Example: 'votemper: int=linear; flt=hann; ext=dist_weight',
+!>                   'vosaline: int=cubic'
+!>          @note 
+!>             If you do not specify a method which is required, 
+!>             default one is apply.
+!>
 !>    * _nesting namelist (namnst)_:<br/>
 !>       - in_rhoi  : refinement factor in i-direction
 !>       - in_rhoj  : refinement factor in j-direction
 !>       @note 
-!>          coarse grid indices will be deduced from fine grid
+!>          coarse grid indices will be computed from fine grid
 !>          coordinate file.
 !>
 !>    * _output namelist (namout)_:<br/>
 !>       - cn_fileout : output file
+!>       - ln_extrap : extrapolate land point or not
+!>       - in_niproc : number of processor in i-direction
+!>       - in_njproc : number of processor in j-direction
 !>       - in_nproc  : total number of processor to be used
-!>       - in_niproc : i-direction number of processor
-!>       - in_njproc : j-direction numebr of processor
 !>       - cn_type   : output format ('dimg', 'cdf')
 !>
@@ -148,4 +153,9 @@
 !> - 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.
+!> @date September, 2015
+!> - manage useless (dummy) variable, attributes, and dimension
 !>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -176,5 +186,4 @@
    IMPLICIT NONE
 
-
    ! local variable
    CHARACTER(LEN=lc)                                  :: cl_namelist
@@ -204,4 +213,5 @@
 
    LOGICAL                                            :: ll_exist
+   LOGICAL                                            :: ll_sameGrid
 
    TYPE(TDOM)                                         :: tl_dom1
@@ -234,53 +244,54 @@
    ! namelist variable
    ! namlog
-   CHARACTER(LEN=lc) :: cn_logfile = 'create_restart.log' 
-   CHARACTER(LEN=lc) :: cn_verbosity = 'warning' 
-   INTEGER(i4)       :: in_maxerror = 5
+   CHARACTER(LEN=lc)                       :: cn_logfile = 'create_restart.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' 
+   CHARACTER(LEN=lc)                       :: cn_dumcfg = 'dummy.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
-   INTEGER(i4)       :: in_extrap = 0
+   CHARACTER(LEN=lc)                       :: cn_coord1 = ''
+   CHARACTER(LEN=lc)                       :: cn_bathy1 = ''
+   INTEGER(i4)                             :: in_perio1 = -1
 
    !namzgr
-   REAL(dp)          :: dn_pp_to_be_computed = 0._dp
-   REAL(dp)          :: dn_ppsur     = -3958.951371276829_dp
-   REAL(dp)          :: dn_ppa0      =   103.9530096000000_dp
-   REAL(dp)          :: dn_ppa1      =     2.4159512690000_dp
-   REAL(dp)          :: dn_ppa2      =   100.7609285000000_dp
-   REAL(dp)          :: dn_ppkth     =    15.3510137000000_dp
-   REAL(dp)          :: dn_ppkth2    =    48.0298937200000_dp
-   REAL(dp)          :: dn_ppacr     =     7.0000000000000_dp
-   REAL(dp)          :: dn_ppacr2    =    13.000000000000_dp
-   REAL(dp)          :: dn_ppdzmin   = 6._dp
-   REAL(dp)          :: dn_pphmax    = 5750._dp
-   INTEGER(i4)       :: in_nlevel    = 75
+   REAL(dp)                                :: dn_pp_to_be_computed = 0._dp
+   REAL(dp)                                :: dn_ppsur   = -3958.951371276829_dp
+   REAL(dp)                                :: dn_ppa0    =   103.953009600000_dp
+   REAL(dp)                                :: dn_ppa1    =     2.415951269000_dp
+   REAL(dp)                                :: dn_ppa2    =   100.760928500000_dp
+   REAL(dp)                                :: dn_ppkth   =    15.351013700000_dp
+   REAL(dp)                                :: dn_ppkth2  =    48.029893720000_dp
+   REAL(dp)                                :: dn_ppacr   =     7.000000000000_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
+   REAL(dp)                                :: dn_e3zps_min = 25._dp
+   REAL(dp)                                :: dn_e3zps_rat = 0.2_dp
 
    ! namvar
+   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = ''
    CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = ''
-   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = ''
 
    ! namnst
-   INTEGER(i4)       :: in_rhoi = 0
-   INTEGER(i4)       :: in_rhoj = 0
+   INTEGER(i4)                             :: in_rhoi = 0
+   INTEGER(i4)                             :: in_rhoj = 0
 
    ! namout
-   CHARACTER(LEN=lc) :: cn_fileout = 'restart.nc' 
-   INTEGER(i4)       :: in_nproc   = 0
-   INTEGER(i4)       :: in_niproc  = 0
-   INTEGER(i4)       :: in_njproc  = 0
-   CHARACTER(LEN=lc) :: cn_type    = ''
+   CHARACTER(LEN=lc)                       :: cn_fileout = 'restart.nc' 
+   LOGICAL                                 :: ln_extrap  = .FALSE.
+   INTEGER(i4)                             :: in_nproc   = 0
+   INTEGER(i4)                             :: in_niproc  = 0
+   INTEGER(i4)                             :: in_njproc  = 0
+   CHARACTER(LEN=lc)                       :: cn_type    = ''
 
    !-------------------------------------------------------------------
@@ -292,5 +303,6 @@
 
    NAMELIST /namcfg/ &  !< configuration namelist
-   &  cn_varcfg         !< variable configuration file
+   &  cn_varcfg, &      !< variable configuration file
+   &  cn_dumcfg         !< dummy configuration file
 
    NAMELIST /namcrs/ &  !< coarse grid namelist
@@ -301,6 +313,5 @@
    &  cn_coord1,   &    !< coordinate file
    &  cn_bathy1,   &    !< bathymetry file
-   &  in_perio1,   &    !< periodicity index
-   &  in_extrap
+   &  in_perio1         !< periodicity index
  
    NAMELIST /namzgr/ &
@@ -323,6 +334,6 @@
 
    NAMELIST /namvar/ &  !< variable namelist
-   &  cn_varinfo, &     !< list of variable and interpolation method to be used.
-   &  cn_varfile        !< list of variable file
+   &  cn_varfile, &     !< list of variable file
+   &  cn_varinfo        !< list of variable and interpolation method to be used.
    
    NAMELIST /namnst/ &  !< nesting namelist
@@ -332,7 +343,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 +359,5 @@
       CALL GET_COMMAND_ARGUMENT(1,cl_namelist) !f03 intrinsec
    ENDIF
-   
+
    ! read namelist
    INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist)
@@ -374,4 +386,11 @@
       ! get variable extra information
       CALL var_def_extra(TRIM(cn_varcfg))
+
+      ! get dummy variable
+      CALL var_get_dummy(TRIM(cn_dumcfg))
+      ! get dummy dimension
+      CALL dim_get_dummy(TRIM(cn_dumcfg))
+      ! get dummy attribute
+      CALL att_get_dummy(TRIM(cn_dumcfg))
 
       READ( il_fileid, NML = namcrs )
@@ -434,5 +453,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 +491,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
@@ -507,5 +520,5 @@
 
                jvar=jvar+1
-               
+
                WRITE(*,'(2x,a,a)') "work on variable "//&
                &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name)
@@ -514,5 +527,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
@@ -545,17 +561,29 @@
             CALL iom_mpp_close(tl_mpp)
 
-            IF( ANY( tl_mpp%t_dim(1:2)%i_len /= &
-            &        tl_coord0%t_dim(1:2)%i_len) )THEN
+            IF( ANY(tl_mpp%t_dim(1:2)%i_len /= tl_coord0%t_dim(1:2)%i_len) .OR.&
+            &   ALL(il_rho(:)==1) )THEN
             !!! extract value from fine grid 
 
-               IF( ANY( tl_mpp%t_dim(1:2)%i_len <= &
+               IF( ANY( tl_mpp%t_dim(1:2)%i_len < &
                &        tl_coord1%t_dim(1:2)%i_len) )THEN
-                  CALL logger_fatal("CREATE RESTART: dimension in file "//&
+                  CALL logger_fatal("CREATE RESTART: dimensions in file "//&
                   &  TRIM(tl_mpp%c_name)//" smaller than those in fine"//&
                   &  " grid coordinates.")
                ENDIF
 
+               ! use coord0 instead of mpp for restart file case 
+               !  (without lon,lat)
+               ll_sameGrid=.FALSE.
+               IF( ALL(tl_mpp%t_dim(1:2)%i_len /= tl_coord0%t_dim(1:2)%i_len) &
+               &   )THEN
+                  ll_sameGrid=.TRUE. 
+               ENDIF
+
                ! compute domain on fine grid
-               il_ind(:,:)=grid_get_coarse_index(tl_mpp, tl_coord1 )
+               IF( ll_sameGrid )THEN
+                  il_ind(:,:)=grid_get_coarse_index(tl_mpp, tl_coord1 )
+               ELSE
+                  il_ind(:,:)=grid_get_coarse_index(tl_coord0, tl_coord1 )
+               ENDIF
 
                il_imin1=il_ind(1,1) ; il_imax1=il_ind(1,2)
@@ -563,8 +591,15 @@
 
                !- check grid coincidence
-               CALL grid_check_coincidence( tl_mpp, tl_coord1, &
-               &                            il_imin1, il_imax1, &
-               &                            il_jmin1, il_jmax1, &
-               &                            il_rho(:) )
+               IF( ll_sameGrid )THEN
+                  CALL grid_check_coincidence( tl_mpp, tl_coord1, &
+                  &                            il_imin1, il_imax1, &
+                  &                            il_jmin1, il_jmax1, &
+                  &                            il_rho(:) )
+               ELSE
+                  CALL grid_check_coincidence( tl_coord0, tl_coord1, &
+                  &                            il_imin1, il_imax1, &
+                  &                            il_jmin1, il_jmax1, &
+                  &                            il_rho(:) )
+               ENDIF
 
                ! compute domain
@@ -579,5 +614,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 +635,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 +663,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 +678,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 +706,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 +731,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 +752,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 +762,5 @@
    IF( in_niproc == 0 .AND. &
    &   in_njproc == 0 .AND. &
-   &   in_nproc  == 0 )THEN
+   &   in_nproc == 0 )THEN
       in_niproc = 1
       in_njproc = 1
@@ -745,4 +783,5 @@
 
    DO ji=1,ip_maxdim
+
       IF( tl_dim(ji)%l_use )THEN
          CALL mpp_move_dim(tl_mppout, tl_dim(ji))
@@ -754,4 +793,5 @@
          END SELECT 
       ENDIF
+
    ENDDO
 
@@ -782,5 +822,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 +832,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 +838,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 +847,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 +874,7 @@
    ENDIF
 
+   ! print
+   CALL mpp_print(tl_mppout)
+
    ! create file
    CALL iom_mpp_create(tl_mppout)
@@ -847,13 +885,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)
@@ -873,22 +910,24 @@
    !> and with dimension of the coordinate file.<br/> 
    !> Then the variable array of value is split into equal subdomain.
-   !> Each subdomain is filled with the corresponding value of the matrix.
+   !> Each subdomain is filled with the associated value of the matrix.
    !>
    !> @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 +938,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 +953,4 @@
       !----------------------------------------------------------------
 
-      ! look for ghost cell
-      il_xghost(:,:)=grid_get_ghost( td_coord )
-
       ! write value on grid
       ! get matrix dimension
@@ -929,6 +964,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 +1027,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 +1038,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_var variable structure
@@ -1071,8 +1100,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 +1110,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 +1119,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 +1148,4 @@
          il_jext=2
       ENDIF
-
       ! work on variable
       ! add extraband
@@ -1125,8 +1153,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 +1171,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2014- Initial Version
+   !> @date November, 2014 - Initial Version
    !>
    !> @param[in] td_mpp       mpp structure
@@ -1175,6 +1200,6 @@
             &        tl_depth%d_value(:,:,:,:) ) )THEN
 
-               CALL logger_fatal("CREATE BOUNDARY: depth value from "//&
-               &  TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//&
+               CALL logger_warn("CREATE BOUNDARY: depth value from "//&
+               &  TRIM(td_mpp%c_name)//" not conform "//&
                &  " to those from former file(s).")
 
@@ -1197,5 +1222,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2014- Initial Version
+   !> @date November, 2014 - Initial Version
    !>
    !> @param[in] td_mpp      mpp structure
@@ -1220,4 +1245,5 @@
 
       ! get or check depth value
+
       IF( td_mpp%t_proc(1)%i_timeid /= 0 )THEN
 
@@ -1231,6 +1257,6 @@
             IF( tl_date1 - tl_date2 /= 0 )THEN
 
-               CALL logger_fatal("CREATE BOUNDARY: date from "//&
-               &  TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//&
+               CALL logger_warn("CREATE BOUNDARY: date from "//&
+               &  TRIM(td_mpp%c_name)//" not conform "//&
                &  " to those from former file(s).")
 
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/dimension.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/dimension.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/dimension.f90	(revision 6440)
@@ -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/>
+!>    to reorder a 1D array of 4 elements in "disordered" dimension:<br/>
 !> @code
-!>    CALL dim_reorder_2xyzt(tl_dim(:), tab(:))
+!>    CALL dim_reorder_xyzt2(tl_dim(:), tab(:))
 !> @endcode
 !>       - tab must be a 1D array with 4 elements "ordered".
@@ -154,4 +154,6 @@
 ! REVISION HISTORY:
 !> @date November, 2013 - Initial Version
+!> @date Spetember, 2015
+!> - manage useless (dummy) dimension
 !>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -168,4 +170,6 @@
    PUBLIC :: TDIM              !< dimension structure
 
+   PRIVATE :: cm_dumdim        !< dummy dimension array
+
    ! function and subroutine
    PUBLIC :: dim_init          !< initialize dimension structure
@@ -173,6 +177,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')
@@ -182,4 +186,6 @@
    PUBLIC :: dim_get_index     !< get dimension index in array of dimension structure
    PUBLIC :: dim_get_id        !< get dimension id in array of dimension structure
+   PUBLIC :: dim_get_dummy     !< fill dummy dimension array
+   PUBLIC :: dim_is_dummy      !< check if dimension is defined as dummy dimension
 
    PRIVATE :: dim__reshape_2xyzt_dp ! reshape real(8) 4D array to ('x','y','z','t')
@@ -209,4 +215,6 @@
    END TYPE
 
+   CHARACTER(LEN=lc), DIMENSION(ip_maxdum), SAVE :: cm_dumdim !< dummy dimension
+
    INTERFACE dim_print
       MODULE PROCEDURE dim__print_unit ! print information on one dimension
@@ -321,5 +329,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 +511,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 +526,8 @@
    !> @param[in] ld_uld    dimension unlimited
    !> @param[in] cd_sname  dimension short name
+   !> @param[in] ld_use    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 +537,5 @@
       LOGICAL,          INTENT(IN), OPTIONAL :: ld_uld
       CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_sname
+      LOGICAL,          INTENT(IN), OPTIONAL :: ld_use
 
       ! local variable
@@ -543,5 +560,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 +611,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 +676,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 +709,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 +716,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 +734,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 +745,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 +835,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 +846,5 @@
    !> @param[inout] td_dim array of dimension structure
    !-------------------------------------------------------------------
-   SUBROUTINE dim_unorder(td_dim)
+   SUBROUTINE dim_disorder(td_dim)
       IMPLICIT NONE
       ! Argument      
@@ -835,5 +859,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 +892,5 @@
       ENDIF
 
-   END SUBROUTINE dim_unorder
+   END SUBROUTINE dim_disorder
    !-------------------------------------------------------------------
    !> @brief This function reshape real(8) 4D array   
@@ -908,5 +932,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 +939,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 +997,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 +1034,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 +1041,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 +1130,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 +1142,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 +1169,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 +1192,5 @@
    !
    !> @author J.Paul
-   !> @date Nov, 2013 - Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_dim array of dimension structure
@@ -1193,6 +1219,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 +1231,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 +1264,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 +1320,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 +1352,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        
@@ -1383,4 +1409,96 @@
 
    END SUBROUTINE dim__clean_arr
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill dummy dimension array
+   !
+   !> @author J.Paul
+   !> @date September, 2015 - Initial Version
+   !
+   !> @param[in] cd_dummy dummy configuration file
+   !-------------------------------------------------------------------
+   SUBROUTINE dim_get_dummy( cd_dummy )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_dummy
+
+      ! local variable
+      INTEGER(i4)   :: il_fileid
+      INTEGER(i4)   :: il_status
+
+      LOGICAL       :: ll_exist
+
+      ! loop indices
+      ! namelist
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumvar
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumdim
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumatt
+
+      !----------------------------------------------------------------
+      NAMELIST /namdum/ &   !< dummy namelist
+      &  cn_dumvar, &       !< variable  name
+      &  cn_dumdim, &       !< dimension name
+      &  cn_dumatt          !< attribute name
+      !----------------------------------------------------------------
+
+      ! init
+      cm_dumdim(:)=''
+
+      ! read namelist
+      INQUIRE(FILE=TRIM(cd_dummy), EXIST=ll_exist)
+      IF( ll_exist )THEN
+
+         il_fileid=fct_getunit()
+
+         OPEN( il_fileid, FILE=TRIM(cd_dummy), &
+         &                FORM='FORMATTED',       &
+         &                ACCESS='SEQUENTIAL',    &
+         &                STATUS='OLD',           &
+         &                ACTION='READ',          &
+         &                IOSTAT=il_status)
+         CALL fct_err(il_status)
+         IF( il_status /= 0 )THEN
+            CALL logger_fatal("DIM GET DUMMY: opening "//TRIM(cd_dummy))
+         ENDIF
+
+         READ( il_fileid, NML = namdum )
+         cm_dumdim(:)=cn_dumdim(:)
+
+         CLOSE( il_fileid )
+
+      ENDIF
+
+   END SUBROUTINE dim_get_dummy
+   !-------------------------------------------------------------------
+   !> @brief This function check if dimension is defined as dummy dimension
+   !> in configuraton file
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial Version
+   !
+   !> @param[in] td_dim dimension structure
+   !> @return true if dimension is dummy dimension 
+   !-------------------------------------------------------------------
+   FUNCTION dim_is_dummy(td_dim)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TDIM), INTENT(IN) :: td_dim
+      
+      ! function
+      LOGICAL :: dim_is_dummy
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      dim_is_dummy=.FALSE.
+      DO ji=1,ip_maxdum
+         IF( fct_lower(td_dim%c_name) == fct_lower(cm_dumdim(ji)) )THEN
+            dim_is_dummy=.TRUE.
+            EXIT
+         ENDIF
+      ENDDO
+
+   END FUNCTION dim_is_dummy
 END MODULE dim
 
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/docsrc/1_install.md
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/docsrc/1_install.md	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/docsrc/1_install.md	(revision 6440)
@@ -1,25 +1,27 @@
-# How to Install
+# Download
 
-# Install NEMO
-to install SIREN, you should first install NEMO.
-see [here](http://www.nemo-ocean.eu/Using-NEMO/User-Guides/Basics/NEMO-Quick-Start-Guide)
+# Download NEMO #
+to install SIREN, you should first download NEMO.
+see [NEMO quick start guide](http://www.nemo-ocean.eu/Using-NEMO/User-Guides/Basics/NEMO-Quick-Start-Guide)
 
-# Compile SIREN
+# Compile SIREN #
 when NEMO is installed, you just have to compile SIREN codes:
-1. go to ./NEMOGCM/TOOLS
-2. use maketools <br/>
-   to get help: maketools -h 
+   1. go to ./NEMOGCM/TOOLS
+   2. run maketools (ex: ./maketools -n SIREN -m ifort_mpi_beaufix)
 
-# Fortran Compiler
-   SIREN codes were succesfully tested with :
-   - ifort (version 12.0.4)
-   - gfortran (version 4.7.2 20121109)
-<!--   - pgf95 (version 13.9-0) -->
+      @note to get help on maketools: ./maketools -h
 
- <HR>
-   <b>
-   - @ref index
-   - @ref md_docsrc_3_codingRules
-   - @ref md_docsrc_4_changeLog
-   - @ref todo
-   </b>
+# Fortran Compiler #
+SIREN codes were succesfully tested with :
+  - ifort (version 15.0.1)
+  - gfortran (version 4.8.2 20140120) 
+
+<HR>
+  <b>
+  - @ref index
+  - @ref md_docsrc_2_quickstart
+  - @ref md_docsrc_3_support_bug
+  - @ref md_docsrc_4_codingRules
+  - @ref md_docsrc_5_changeLog
+  - @ref todo
+  </b>
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/docsrc/2_quickstart.md
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/docsrc/2_quickstart.md	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/docsrc/2_quickstart.md	(revision 6440)
@@ -0,0 +1,600 @@
+# How To Use (Quick Start)
+
+@tableofcontents
+
+SIREN is a software to set up regional configuration with
+ [NEMO](http://www.nemo-ocean.eu).<br/> 
+Actually SIREN creates all the input files you need to run a NEMO regional configuration.<br/>
+ 
+SIREN is composed of a set of 5 Fortran programs :
+<ul>
+ <li>create_coord.f90 to create regional grid coordinates.</li>
+ <li>create_bathy.f90 to create regional grid bathymetry.</li>
+ <li>merge_bathy.f90 to merge regional grid bathymetry with wider grid bathymetry
+ at boundaries. 
+ @note the goal of this step is to avoid break in Bathymetry.
+ This break may cause inconsistency between forcing fields  at boundary and regional fields.
+ </li>
+ <li>create_restart.f90 to create initial state file from coarse grid restart
+ or standard outputs.
+ @note this program could also be used to refined other input fields from a wider
+ configuations (as runoff, chlorophyll etc...)
+ </li>
+ <li>create_boundary.F90 to create boundaries conditions from wider configurations
+ output fields.
+ </li>
+</ul>
+
+@warning SIREN can not:
+<ul>
+<li>create global configuration.</li>
+<li>create configuarion around or close to North pole.</li>
+<li>change number of vertical level.</li>
+</ul>
+
+Here after we briefly describe how to use each programs,
+and so how to create your own regional configuration.
+@note A set of GLORYS files (global reanalysis on *ORCA025*
+grid), as well as examples of namelists are available in dods repository.<br/>
+You could create and forced a first release of your own regional configuration,
+with those files. 
+<!-- ######################################################################  -->
+# Create coordinates file # {#coord}
+
+To create your own configuration, you first have to create a coordinates file on your domain of study.<br/>
+SIREN allows you to create this coordinates file from a wider coordinates file.<br/>
+The coordinates file created could simply be an extraction, or a refinment of
+the wide grid.<br/>
+
+To create this new cooridnates file, you have to run :
+~~~~~~~~~~~~~~~~~~
+./SIREN/create_coord.exe create_coord.nam
+~~~~~~~~~~~~~~~~~~
+
+Here after is an example of namelist for *create_coord.exe*.<br/>
+In this example, you create a coordinates file named *coord_fine.nc*.<br/>
+This new coordinates file is refined from an extraction of *coordinates_ORCA025.nc*. 
+~~~~~~~~~~~
+&namlog
+/
+
+&namcfg
+   cn_varcfg = "PATH/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg"
+/
+
+&namcrs
+   cn_coord0 = "PATH/coordinates_ORCA025.nc"
+   in_perio0 = 4
+/
+
+&namvar
+/
+
+&namnst
+   in_imin0 = 1070
+   in_imax0 = 1072
+   in_jmin0 = 607
+   in_jmax0 = 609
+
+   in_rhoi = 2
+   in_rhoj = 3
+/
+
+&namout
+   cn_fileout = "PATH/coord_fine.nc"
+/
+~~~~~~~~~~~
+
+Let's get describe this namelist.<br/>
+First we have the **namlog** sub-namelist. This sub-namelist set parameters of the log
+file.<br/>
+All the parameters of this sub-namelist have default value, so you could let it
+empty, as done here.<br/> This will create a log file named *create_coord.log*
+
+The **namcfg** sub-namelist defines where found SIREN configuration file.<br/>
+This configuration file defines standard name, default interpolation method,
+axis,... to be used for some known variables.<br/>
+Obviously, you could add other variables to those already list, in this file.
+
+@note You could find the generic version of *variable.cfg* in the directory *NEMOGCM/TOOLS/SIREN/cfg*.
+
+The **namcrs** sub-namelist set parameters of the wide
+coordinates file,<br/> as path to find it, and NEMO periodicity of the wide grid.<br/>
+
+@note the NEMO periodicity could be choose between 0 to 6:
+<dl>
+<dt>in_perio=0</dt>
+<dd>standard regional model</dd>
+<dt>in_perio=1</dt>
+<dd>east-west cyclic model</dd>
+<dt>in_perio=2</dt>
+<dd>model with symmetric boundary condition across the equator</dd>
+<dt>in_perio=3</dt>
+<dd>regional model with North fold boundary and T-point pivot</dd>
+<dt>in_perio=4</dt>
+<dd>global model with a T-point pivot.<br/>
+example: ORCA2, ORCA025, ORCA12</dd>
+<dt>in_perio=5</dt>
+<dd>regional model with North fold boundary and F-point pivot</dd>
+<dt>in_perio=6</dt>
+<dd>global model with a F-point pivot<br/>
+example: ORCA05</dd>
+</dl>
+@sa For more information see @ref md_docsrc_6_perio
+</dd>
+</dl>
+
+The **namvar** sub-namelist lists variables to be used.<br/>
+By default all the variables of the wider coordinates file are used to create
+the new coordinates file.<br/> 
+The interpolation methods to be used are defined in the configuration variables file (see
+below). So you do not need to fill this sub-namelist too.
+
+The **namnst** sub-namelist defines the subdomain to be used as well as refinment factor.<br/>
+@note Subdomain is defined by indices of the coarse/wide grid.<br/>
+
+<ul>
+<li>you can select area quite every where (excepted too close from the North
+pole), and use the refinment factor you want.</li>
+
+~~~~~~~~~~~
+&namvar
+   in_imin0 = 1070
+   in_imax0 = 1072
+   in_jmin0 = 607
+   in_jmax0 = 609
+
+   in_rhoi = 2
+   in_rhoj = 3
+/
+~~~~~~~~~~~
+@image html grid_zoom_60.png
+@image latex grid_zoom_40.png
+<!-- @note ghost cells all around the grid are not shown here. -->
+
+<li>you can select area crossing the east-west overlap of the global ORCA grid.</li>
+
+~~~~~~~~~~~
+&namvar          
+   in_imin0 = 1402 
+   in_imax0 = 62
+   in_jmin0 = 490 
+   in_jmax0 = 570 
+
+   in_rhoi = 5
+   in_rhoj = 5 
+/                
+~~~~~~~~~~~
+@image html grid_glob_over_30.png
+@image latex grid_glob_over_20.png
+<!-- @note in blue, the east-west overlap band of ORCA grid. -->
+
+<li>you can select east-west cyclic area.</li>
+
+~~~~~~~~~~~
+&namvar
+   in_imin0 = 0
+   in_imax0 = 0
+   in_jmin0 = 390
+   in_jmax0 = 450
+
+   in_rhoi = 1
+   in_rhoj = 1
+/
+~~~~~~~~~~~
+@image html grid_glob_band_30.png
+@image latex grid_glob_band_20.png
+
+</ul>
+
+Finally the **namout** sub-namelist defines the output file.<br/>
+
+@note All the output files created by SIREN include information about NEMO
+periodicity, as well as source file, indices and refinment used.
+
+@sa For more information about how to create coordinates, see create_coord.f90
+
+<!-- ######################################################################  -->
+# Create bathymetry file # {#bathy}
+
+Then you need a Bathymetry file.<br/>
+SIREN allows you to create a Bathymetry extracted or refined from a wider
+Bathymetry grid.<br/>
+
+To create this new bathymetry, you have to run :
+~~~~~~~~~~~~~~~~~~
+./SIREN/create_bathy.exe create_bathy.nam
+~~~~~~~~~~~~~~~~~~
+
+Here after is an example of namelist for *create_bathy.exe*.<br/>
+In this example, you create a bathymetry file named *bathy_fine.nc*.<br/>
+This new bathymetry file is refined from an extraction of *bathy_meter_ORCA025.nc*.<br/>
+Moreover a minimum value of 5m is imposed to the output Bathymetry.
+~~~~~~~~~~~~~~~~~~
+&namlog
+/
+
+&namcfg
+   cn_varcfg = "PATH/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg"
+/
+
+&namcrs
+   cn_coord0 = "PATH/coordinates_ORCA025.nc"
+   in_perio0 = 4
+/
+
+&namfin
+   cn_coord1 = "PATH/coord_fine.nc"
+/
+
+&namvar
+   cn_varfile = "Bathymetry:PATH/bathy_meter_ORCA025.nc"
+   cn_varinfo = "Bathymetry: min=5"
+/
+
+&namnst
+   in_rhoi = 2
+   in_rhoj = 3
+/
+
+&namout
+   cn_fileout = "PATH/bathy_fine.nc"      
+/
+~~~~~~~~~~~~~~~~~~
+
+Let's get describe this namelist.<br/>
+
+First as previously, we have the **namlog** and **namcfg** sub-namelist (see above for more
+explanation).<br/>
+
+Then the **namcrs** sub-namelist set parameters of the wide
+coordinates file.<br/>
+@note in all SIREN namelist: <br/>
+0 referred to the coarse/wide grid.<br/>
+1 referred to the fine grid.
+
+In the same way, the **namfin** sub-namelist  set parameters of the fine
+coordinates file.<br/>
+@note in this namelist example, there is no need to set the variable *in_perio1* to define the NEMO
+periodicity of the fine grid.<br/> Indeed, if this variable is not inform, SIREN tries to read it in the attributes of the file.<br/> 
+So if you created the fine coordinates with SIREN, you do not have to
+fill it. In other case, you should add it to the namelist.
+
+The **namvar** sub-namelist lists variables to be used:
+<dl>
+   <dt>cn_varfile</dt>
+      <dd> defines the variable name ("Bathymetry" here) and the input file associated with.
+            @warning The domain of the input Bathymetry have to be larger than the output domain.
+         @note 
+         <ul>
+            <li>if the input file is at coarse grid resolution (same than *cn_coord0*), the ouptut Bathymetry will be refined on fine grid.</li>
+            <li>if the input file is a wider bathymetry (already at fine grid resolution), the output Bathymetry will be extracted from this one.</li>
+         </ul>
+      </dd>
+   <dt>cn_varinfo</dt>
+      <dd> defines user's requests for a variable.
+         @note Default interpolation method for the Bathymetry, is *cubic* interpolation.<br/>
+         So you may want to specify a minimum value to avoid negative value, or to change interpolation method.<br/>
+         example: <ul><li>cn_varinfo="Bathymetry: min=1"'</li>
+                      <li>cn_varinfo="Bathymetry: int=linear"</li></ul>
+      </dd>
+</dl>
+
+The **namnst** sub-namelist defines the subdomain refinment factor.<br/>
+Of course those refinment factors have to be convenient with refinment
+from coarse grid *cn_coord0* to fine grid *cn_coord1*.
+@note subdomain indices are automatically deduced from fine and coarse grid
+coordinates.
+
+Finally, this **namout** sub-namelist defines the output file.<br/>
+
+@note All the output files create by SIREN include information about 
+source file, indices, refinment and interpolation method used.
+
+@sa For more information about how to create bathymetry, see
+create_bathy.f90
+
+<!-- ######################################################################  -->
+# Merge bathymetry file # {#merge}
+
+The Bathymetry you build differs from the wider one.<br/>
+To avoid issue with boundaries forcing fields, you should merge fine and coarse Bathymetry on boundaries.<br/>
+SIREN allows you to do this.<br/>
+
+To create this merged bathymetry, you have to run :
+~~~~~~~~~~~~~~~~~~
+./SIREN/merge_bathy.exe merge_bathy.nam
+~~~~~~~~~~~~~~~~~~
+
+Here after is an example of namelist for *merge_bathy.exe*.<br/>
+~~~~~~~~~~~~~~~~~~
+&namlog
+/
+
+&namcfg
+   cn_varcfg = "PATH/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg"
+/
+
+&namcrs
+   cn_bathy0 = "PATH/bathy_meter_ORCA025.nc"
+   in_perio0 = 4
+/
+
+&namfin
+   cn_bathy1 = "PATH/bathy_fine.nc"
+/
+
+&namnst
+   in_rhoi = 3
+   in_rhoj = 3
+/
+
+&nambdy
+/
+
+&namout
+   cn_fileout = "PATH/bathy_merged.nc"      
+/
+~~~~~~~~~~~~~~~~~~
+In this namelist, you find again the **namlog**, **namcfg** describe above.
+
+Then the **namcrs** sub-namelist sets parameters of the wider grid.
+However this time, this is the coarse/wide grid Bathymetry wich have to be informed.
+
+The **namfin** sub-namelist defines parameters of the fine grid Bathymetry.
+@note here again you could add the *in_perio1* parameter if need be i.e. if your
+fine grid Bathymetry was not created by SIREN.
+
+The **namnst** sub-namelist defines the subdomain refinment factor.
+
+
+The **nambdy** sub-namelist defines the subdomain boundaries.<br/>
+By default SIREN tries to create boundaries for each side. Boundary exist if there is at least one sea point on the second row of each side.<br/>
+So you could let this namelist empty.
+
+@sa For more information about boundaries, see @ref boundary
+
+Finally, this **namout** sub-namelist defines the output file.<br/>
+
+@sa For more information about how to merge bathymetry, see
+merge_bathy.f90
+
+<!-- ######################################################################  -->
+# Create initial state # {#restart}
+
+To run your configuration you need an inital state of the ocean.<br/>
+You could start from a restart file (with all NEMO variables fields at one
+time step). Or you could start from "partial" information about ocean state (Temperature and Salinity for example).
+
+Siren allows you to create both of those initial state.<br/>
+To create the initial state, you have to run:<br/>
+~~~~~~~~~~~~~~~~~~
+./SIREN/create_restart.exe create_restart.nam
+~~~~~~~~~~~~~~~~~~
+
+Here after is an example of namelist for *create_restart.exe*.<br/>
+In this example, you create an initial state split on 81 "processors", and named restar_out.nc.<br/>
+The initial state is composed of temperature and salinity refined from an extraction of GLORYS fields.
+~~~~~~~~~~~~~~~~~~
+&namlog
+/
+
+&namcfg
+   cn_varcfg = "PATH/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg"
+/
+
+&namcrs
+   cn_coord0 = "PATH/coordinates_ORCA025.nc"
+   in_perio0 = 4
+/
+
+&namfin
+   cn_coord1 = "PATH/coord_fine.nc"
+   cn_bathy1 = "PATH/bathy_merged.nc"
+/
+
+&namzgr
+/
+
+&namzps
+/
+
+&namvar
+   cn_varfile = "votemper:GLORYS_gridT.nc",
+                "vosaline:GLORYS_gridS.nc"
+/
+
+&namnst
+   in_rhoi = 3
+   in_rhoj = 3
+/
+
+&namout
+   cn_fileout = "PATH/restart_out.nc"      
+   in_nproc = 81
+/
+~~~~~~~~~~~~~~~~~~
+Let's get describe this namelist more accurately.<br/>
+
+As previously, we have the **namlog** and **namcfg** sub-namelists, as well as 
+the **namcrs** sub-namelist to set parameters of the wide coordinates file (see above for more
+explanation).<br/>
+
+Then the **namfin** sub-namelist set parameters of the fine
+grid coordinates and bathymetry.<br/>
+
+The **namzgr** and **namzps** sub-namelists define respectively parameters for vertical grid
+and partial step.<br>
+By default, those parameters are defined the same way than in GLORYS (i.e. 75 vertical levels).<br/>
+So you could let it empty.
+@note If you use forcing fields other than GLORYS, you have to be sure it uses the same vertical grid. In other case, you need to get information about the parametrisation use, and to put it in those sub-namelist (see create_restart.f90).
+
+the **namvar** sub-namelist lists variables to be used.<br/>
+Here we use *votemper* (temperature) get from *GLORYS_gridT.nc* file, and *vosaline*
+(salinity) get from *GLORYS_gridS.nc* file.
+@note To get all variables of a restart file. You have to use:
+~~~~~~~~~~~~~~~~~~
+cn_varfile = "all:PATH/restart.dimg"
+~~~~~~~~~~~~~~~~~~
+
+The **namnst** sub-namelist defines the subdomain refinment factor, as seen previously.<br/>
+
+Finally, this **namout** sub-namelist defines the output files.<br/>
+Here we ask for output on 81 processors, with *restart_out.nc* as file "basename".<br/>
+So SIREN computes the optimal layout for 81 porcessors
+available,<br/>
+and split restart on output files named *restart_out_num.nc*, where *num* is the porc number.
+
+@note SIREN could also create the other fields you may need for
+your configuration.<br/>
+To do so, you just have to run *create_restart.exe* with other variable(s) from other input file(s).<br/>
+For example, to get runoff fields, you could use:
+~~~~~~~~~~~~~~~~~~
+cn_varfile = "sorunoff:PATH/runoff_GLORYS.nc"
+...
+cn_fileout = "PATH/runoff_out.nc"
+~~~~~~~~~~~~~~~~~~
+
+@sa For more information about how to create initial state or other fields, see
+create_restart.f90
+
+<!-- ######################################################################  -->
+# Create boundaries conditions # {#boundary}
+
+Finally to force your configuration, you may need boundaries conditions.<br/>
+NEMO read physical boundaries conditions from temperature, salinity, currents, and sea
+surface height.
+
+To create the boundaries condition with SIREN, you have to run:<br/>
+~~~~~~~~~~~~~~~~~~
+./SIREN/create_boundary.exe create_boundary.nam
+~~~~~~~~~~~~~~~~~~
+
+Here after is an example of namelist for *create_boundary.exe*.<br/>
+In this example, you create boundaries conditions named *boundary_out.nc* on
+each side of the domain.<br/>
+The boundaries contain information about temperature, salinity, currents and sea surface height refined from an extraction of GLORYS fields.
+~~~~~~~~~~~~~~~~~~
+&namlog
+/
+
+&namcfg
+   cn_varcfg = "PATH/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg"
+/
+
+&namcrs
+   cn_coord0 = "PATH/coordinates_ORCA025.nc"
+   in_perio0 = 4
+/
+
+&namfin
+   cn_coord1 = "PATH/coord_fine.nc"
+   cn_bathy1 = "PATH/bathy_fine.nc"
+/
+
+&namzgr
+/
+
+&namzps
+/
+
+&namvar
+   cn_varfile="votemper:GLORYS_gridT.nc",
+              "vosaline:GLORYS_gridS.nc",
+              "vozocrtx:GLORYS_gridU.nc",
+              "vomecrty:GLORYS_gridV.nc",
+              "sossheig:GLORYS_grid2D.nc"
+/
+
+&namnst
+   in_rhoi = 3
+   in_rhoj = 3
+/
+
+&nambdy
+/
+
+&namout
+   cn_fileout = "PATH/boundary_out.nc"      
+/
+~~~~~~~~~~~~~~~~~~
+
+Let's get describe this namelist more accurately.<br/>
+
+As previously, we have the **namlog** and **namcfg** sub-namelists, as well as 
+the **namcrs** sub-namelist to set parameters of the wide coordinates file (see above for more
+explanation).<br/>
+
+Then the **namfin** sub-namelist set parameters of the fine
+grid coordinates and bathymetry.<br/>
+
+The **namzgr** and **namzps** sub-namelists define respectively parameters for vertical grid
+and partial step.<br>
+By default, those parameters are defined the same way than in GLORYS (i.e. 75 vertical levels).<br/>
+So you could let it empty.
+@note If you use forcing fields other than GLORYS, you have to be sure it uses the same vertical grid. In other case, you need to get information about the parametrisation use, and to put it in those sub-namelist (see create_boundary.F90).
+
+the **namvar** sub-namelist lists variables to be used.<br/>
+Here we get *votemper* (temperature) from *GLORYS_gridT.nc* file, *vosaline*
+(salinity) from *GLORYS_gridS.nc* file, *vozocrtx* (zonal velocity) from
+*GLORYS_gridU.nc*, *vomecrty* (meridional velocity) from *GLORYS_gridV.nc*, and sossheig (sea surface
+height) from *GLORYS_grid2D.nc*.
+
+The **namnst** sub-namelist defines the subdomain refinment factor.<br/>
+
+The **nambdy** sub-namelist defines the subdomain boundaries.<br/>
+By default SIREN tries to create boundaries for each side (Boundary is created if sea point exist on the second row of each side).<br/>
+So you could let this namelist empty.
+
+@note SIREN allows you to place boundaries away from the side of the domain.
+To do so you have to define your boundary.<br/>
+That means you have to give on fine
+grid the index of the boundary (how far from the border your boundary is),
+the width of your boundary, and finally first and last point of your boundary (the length of your boundary).<br/>
+So to define a north boundary, you have to add in the sub-namelist *nambdy*, the parameter:
+~~~~~~~~~~~~~~~~~~
+cn_north="index,first:last(width)"
+~~~~~~~~~~~~~~~~~~
+
+Finally, this **namout** sub-namelist defines the output files.<br/>
+Here we ask for output with *boundary_out.nc* as file "basename".<br/>
+So SIREN creates output files named *boundary_out_west.nc*,
+*boundary_out_east.nc*, *boundary_out_north.nc*, and *boundary_out_south.nc*
+depending if boundary exist or not.
+
+@sa For more information about how to create boundaries condition, see
+create_boundary.F90
+
+# Create and run NEMO configuration # {#NEMOconf}
+
+So now you created all the input files you need for your physical configuration, you have to create the "NEMO configuration".<br/>
+To do so, go to the directory *NEMOGCM/CONFIG/*, and run:
+~~~~~~~~~~~~~~~~~~
+./makenemo -n MY_CONFIG -d "OPA_SRC"
+~~~~~~~~~~~~~~~~~~
+This creates your configuration "MY_CONFIG" in the directory *NEMOGCM/CONFIG*.<br/>
+you could check the cpp_keys used in file *cpp_MY_CONFIG.fcm*, and re-run *makenemo*
+if need be.
+
+Once *makenemo* has run successfully, the *opa* executable is available in
+directory *NEMOGCM/CONFIG/MY_CONFIG/EXP00*.<br/>
+Then you just have to put all your input files in this directory, fill the namelist *namelist_cfg*, and run:
+~~~~~~~~~~~~~~~~~~
+mpirun ./opa
+~~~~~~~~~~~~~~~~~~
+
+@note no surface forcing here.
+weighted function needed to do interpolation on the fly, could be created by WEIGHT tools already inside NEMO.
+
+@sa For more information about how to create NEMO configuration see [NEMO Quick Start Guide](http://www.nemo-ocean.eu/Using-NEMO/User-Guides/Basics/NEMO-Quick-Start-Guide).
+
+ <HR>
+   <b>
+   - @ref index
+   - @ref md_docsrc_1_install
+   - @ref md_docsrc_2_quickstart
+   - @ref md_docsrc_3_support_bug
+   - @ref md_docsrc_4_codingRules
+   - @ref md_docsrc_5_changeLog
+   - @ref todo
+   </b>
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/docsrc/3_codingRules.md
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/docsrc/3_codingRules.md	(revision 6439)
+++ 	(revision )
@@ -1,98 +1,0 @@
-# Coding Rules
-
-The conventions used in SIREN coding are based on the NEMO coding rules
-(see [NEMO coding
-conventions](http://www.nemo-ocean.eu/content/download/15483/73221/file/NEMO_coding.conv_v3.pdf)).<br/>
-However some modifications were added to improve readibility of the code.<br/>
-Some of the NEMO coding rules are reminded here, and extensions are described.
-
-@tableofcontents
-
-# Fortran Standard {#std}
-
-SIREN software adhere to strict __FORTRAN 95__ standard.<br/>
-There is only one exception. The use of functions _COMMAND_ARGUMENT_COUNT_ and
-_GET_COMMAND_ARGUMENT_.<br/>
-There exist no equivalent for those Fortran 03 intrinsec functions in Fortran
-95.<br/> At least none convenient for compilers tested (see @ref md_docsrc_1_install). 
-
-#  Free Form Source {#free}
-Free Form Source will be used, however a self imposed limit of 80 should
-enhance readibility.
-
-#  Indentation {#indent}
-Code as well as comments lines will be indented 3 characters for readibility.<br/>
-__Indentation should be write without hard tabs__.
-
-Example for vi  :
-~~~~~~~~~~~~~~~~~~~~~
-:set expandtab tabstop=3 shiftwidth=3
-~~~~~~~~~~~~~~~~~~~~~
-
-#  Naming conventions : variable {#namvar}
-All variables should be named as explicitly as possible.<br/>
-The naming conventions concerns prefix letters of these name, in order to
-identify the variable type and status.<br/> It must be composed of two
-letters defining type and status follow by an underscore.<br/>
-table below list the starting letters to be used for variable naming,
-depending on their type and status.
-
- | Type / Status     | byte (integer(1)) <br/> __b__ | short (integer(2)) <br/> __s__ | integer(4) <br/> __i__  | integer(8) <br/> __k__ | real(4) <br/> __r__ | real(8) <br/> __d__ | logical <br/> __l__ | character <br/> __c__ | complex <br/> __y__ | structure <br/> __t__  |
- | :----:            | :----: | :----: | :----: | :----: | :----: | :----: | :----: | :----: | :----: | :----: |
- |global <br/> __g__           | bg_  | sg_  | ig_  | kg_  | rg_  | dg_  | lg_  | cg_  | yg_  | tg_  |
- |global parameter <br/> __p__ | bp_  | sp_  | ip_  | kp_  | rp_  | dp_  | lp_  | cp_  | yp_  | tp_  |
- |module <br/> __m__           | bm_  | sm_  | im_  | km_  | rm_  | dm_  | lm_  | cm_  | ym_  | tm_  |
- |namelist <br/> __n__         | bn_  | sn_  | in_  | kn_  | rn_  | dn_  | ln_  | cn_  | yn_  | tn_  |
- |dummy argument <br/> __d__   | bd_  | sd_  | id_  | kd_  | rd_  | dd_  | ld_  | cd_  | yd_  | td_  |
- |local <br/> __l__            | bl_  | sl_  | il_  | kl_  | rl_  | dl_  | ll_  | cl_  | yl_  | tl_  |
- |loop control       |      |      | j?   |      |      |      |      |      |      |      |
-
-# Naming conventions : structure {#namstr}
-The structure name should be written in capital letter, and start with
-__T__<br/> Example: TTRACER <br/>
-Variables inside the structure should be named as explicitly as possible.<br/>
-For those variables, the prefix naming conventions only concern the type of variable.<br/>
-It must be composed of one letter defining type follows by an
-underscore.<br/>
-see table of variable conventions.<br/>
-
-Example: __tl\_type\%i\_year__<br/> _year_ is an integer(4) variable in a local strucure
-named _type_. <br/>
-
-# Naming conventions : function-subroutine {#namsub}
-Functions or Subroutines are defined in a module.<br/>
-Their name should start with the module name then with their "functional" name. So it will be
-easy to find it.<br/>
-Example:<br/> a function to realise addition written in a module
-__math__ should be called __math\_add__.<br/>
-
-__PUBLIC__  function or subroutine should used one undescrore: _math_add_<br/>
-__PRIVATE__ function or subroutine should used two undescrores: _math__add_<br/>
-
-# Precision {#precision}
-__All variables should make use of kinds__.<br/>
-Numerical constant need to have a suffix of __kindvalue__
-
-# Declaration for global variable and constants {#global}
-All global data must be accompanied with a comment field on the same
-line.<br/>
-_Note that using doxygen (see [header](#header)), we will use symbol !< instead of !: as separator_
-
-# Implicit none {#implicit}
-All subroutines and functions will include an IMPLICTI NONE statement.
-
-# Header {#header}
-
-SIREN use __doxigen auto documentation__ tool.<br/>
-Information could be find on
-[doxygen](http://www.stack.nl/~dimitri/doxygen/index.html) web page.<br/>
-Some basic tag are described
-[here](http://www.msg.chem.iastate.edu/gamess/DoxygenRules.oct10.pdf).
-
- <HR>
-   <b>
-   - @ref index
-   - @ref md_docsrc_1_install
-   - @ref md_docsrc_4_changeLog
-   - @ref todo
-   </b>
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/docsrc/3_support_bug.md
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/docsrc/3_support_bug.md	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/docsrc/3_support_bug.md	(revision 6440)
@@ -0,0 +1,28 @@
+# Support
+
+# How to get support
+  If you have questions regarding the use of SIREN, please have a look at the [NEMO configuration manager forum](https://forge.ipsl.jussieu.fr/nemo/discussion/forum/2).<br/>
+  If you don't find an answer in the archives, feel free to register and post your question.
+
+# How to Help
+   The development of SIREN highly depends on your input!<br/>
+   If you are trying SIREN let me know what you think of it (do you miss certain features?). Even if you decide not to use it, please let me know why.
+
+# How to report a bug
+   If you believe you have found a new bug, please report it.<br/>
+   Before submitting a new bug, first search through the database if the same bug has already been submitted by others
+
+   If you send only a (vague) description of a bug, you are usually not very
+   helpful and it will cost much more time to figure out what you mean. In
+   the worst-case your bug report may even be completely ignored.
+
+ <HR>
+   <b>
+   - @ref index
+   - @ref md_docsrc_1_install
+   - @ref md_docsrc_2_quickstart
+   - @ref md_docsrc_3_support_bug
+   - @ref md_docsrc_4_codingRules
+   - @ref md_docsrc_5_changeLog
+   - @ref todo
+   </b>
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/docsrc/4_changeLog.md
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/docsrc/4_changeLog.md	(revision 6439)
+++ 	(revision )
@@ -1,18 +1,0 @@
-# Change log
-
-@tableofcontents
-
-# Release 3.6
-Initial release (release date )
-
-## Changes
-## New Features
-## Bug fixes
-
- <HR>
-   <b>
-   - @ref index
-   - @ref md_docsrc_1_install
-   - @ref md_docsrc_3_codingRules
-   - @ref todo
-   </b>
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/docsrc/4_codingRules.md
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/docsrc/4_codingRules.md	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/docsrc/4_codingRules.md	(revision 6440)
@@ -0,0 +1,100 @@
+# Coding Rules
+
+The conventions used in SIREN coding are based on the NEMO coding rules
+(see [NEMO coding
+conventions](http://www.nemo-ocean.eu/content/download/15483/73221/file/NEMO_coding.conv_v3.pdf)).<br/>
+However some modifications were added to improve readibility of the code.<br/>
+Some of the NEMO coding rules are reminded here, and extensions are described.
+
+@tableofcontents
+
+# Fortran Standard {#std}
+
+SIREN software adhere to strict __FORTRAN 95__ standard.<br/>
+There is only one exception. The use of functions _COMMAND_ARGUMENT_COUNT_ and
+_GET_COMMAND_ARGUMENT_.<br/>
+There exist no equivalent for those Fortran 03 intrinsec functions in Fortran
+95.<br/> At least none convenient for compilers tested (see @ref md_docsrc_1_install). 
+
+#  Free Form Source {#free}
+Free Form Source will be used, however a self imposed limit of 80 should
+enhance readibility.
+
+#  Indentation {#indent}
+Code as well as comments lines will be indented 3 characters for readibility.<br/>
+__Indentation should be write without hard tabs__.
+
+Example for vi  :
+~~~~~~~~~~~~~~~~~~~~~
+:set expandtab tabstop=3 shiftwidth=3
+~~~~~~~~~~~~~~~~~~~~~
+
+#  Naming conventions : variable {#namvar}
+All variables should be named as explicitly as possible.<br/>
+The naming conventions concerns prefix letters of these name, in order to
+identify the variable type and status.<br/> It must be composed of two
+letters defining type and status follow by an underscore.<br/>
+table below list the starting letters to be used for variable naming,
+depending on their type and status.
+
+ | Type / Status     | byte (integer(1)) <br/> __b__ | short (integer(2)) <br/> __s__ | integer(4) <br/> __i__  | integer(8) <br/> __k__ | real(4) <br/> __r__ | real(8) <br/> __d__ | logical <br/> __l__ | character <br/> __c__ | complex <br/> __y__ | structure <br/> __t__  |
+ | :----:            | :----: | :----: | :----: | :----: | :----: | :----: | :----: | :----: | :----: | :----: |
+ |global <br/> __g__           | bg_  | sg_  | ig_  | kg_  | rg_  | dg_  | lg_  | cg_  | yg_  | tg_  |
+ |global parameter <br/> __p__ | bp_  | sp_  | ip_  | kp_  | rp_  | dp_  | lp_  | cp_  | yp_  | tp_  |
+ |module <br/> __m__           | bm_  | sm_  | im_  | km_  | rm_  | dm_  | lm_  | cm_  | ym_  | tm_  |
+ |namelist <br/> __n__         | bn_  | sn_  | in_  | kn_  | rn_  | dn_  | ln_  | cn_  | yn_  | tn_  |
+ |dummy argument <br/> __d__   | bd_  | sd_  | id_  | kd_  | rd_  | dd_  | ld_  | cd_  | yd_  | td_  |
+ |local <br/> __l__            | bl_  | sl_  | il_  | kl_  | rl_  | dl_  | ll_  | cl_  | yl_  | tl_  |
+ |loop control       |      |      | j?   |      |      |      |      |      |      |      |
+
+# Naming conventions : structure {#namstr}
+The structure name should be written in capital letter, and start with
+__T__<br/> Example: TTRACER <br/>
+Variables inside the structure should be named as explicitly as possible.<br/>
+For those variables, the prefix naming conventions only concern the type of variable.<br/>
+It must be composed of one letter defining type follows by an
+underscore.<br/>
+see table of variable conventions.<br/>
+
+Example: __tl\_type\%i\_year__<br/> _year_ is an integer(4) variable in a local strucure
+named _type_. <br/>
+
+# Naming conventions : function-subroutine {#namsub}
+Functions or Subroutines are defined in a module.<br/>
+Their name should start with the module name then with their "functional" name. So it will be
+easy to find it.<br/>
+Example:<br/> a function to realise addition written in a module
+__math__ should be called __math\_add__.<br/>
+
+__PUBLIC__  function or subroutine should used one undescrore: _math_add_<br/>
+__PRIVATE__ function or subroutine should used two undescrores: _math__add_<br/>
+
+# Precision {#precision}
+__All variables should make use of kinds__.<br/>
+Numerical constant need to have a suffix of __kindvalue__
+
+# Declaration for global variable and constants {#global}
+All global data must be accompanied with a comment field on the same
+line.<br/>
+_Note that using doxygen (see [header](#header)), we will use symbol !< instead of !: as separator_
+
+# Implicit none {#implicit}
+All subroutines and functions will include an IMPLICIT NONE statement.
+
+# Header {#header}
+
+SIREN use __doxigen auto documentation__ tool.<br/>
+Information could be find on
+[doxygen](http://www.stack.nl/~dimitri/doxygen/index.html) web page.<br/>
+Some basic tag are described
+[here](http://www.msg.chem.iastate.edu/gamess/DoxygenRules.oct10.pdf).
+
+ <HR>
+   <b>
+   - @ref index
+   - @ref md_docsrc_1_install
+   - @ref md_docsrc_2_quickstart
+   - @ref md_docsrc_3_support_bug
+   - @ref md_docsrc_5_changeLog
+   - @ref todo
+   </b>
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/docsrc/5_changeLog.md
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/docsrc/5_changeLog.md	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/docsrc/5_changeLog.md	(revision 6440)
@@ -0,0 +1,20 @@
+# Change log
+
+@tableofcontents
+
+# Release $Revision$
+Initial release (2016-03-17)
+
+## Changes
+## New Features
+## Bug fixes
+
+ <HR>
+   <b>
+   - @ref index
+   - @ref md_docsrc_1_install
+   - @ref md_docsrc_2_quickstart
+   - @ref md_docsrc_3_support_bug
+   - @ref md_docsrc_4_codingRules
+   - @ref todo
+   </b>
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/docsrc/6_perio.md
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/docsrc/6_perio.md	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/docsrc/6_perio.md	(revision 6440)
@@ -0,0 +1,34 @@
+# NEMO periodicity
+
+NEMO periodicity is defined as follow :<br/> 
+<dl>
+<dt>closed boundary (in_perio=0)</dt>
+<dd>ghost cells (solid walls) are imposed at all model boundaries.</dd> 
+@image html perio0_20.png 
+@image latex perio0_20.png
+<dt>cyclic east-west boundary (in_perio=1)</dt>
+<dd>first and last rows are closed, whilst the first column is set to the value of the last-but-one column and the last column to the value of the second one.</dd>  
+@image html perio1_20.png 
+@image latex perio1_20.png
+<dt>symmetric boundary condition across the equator. (in_perio=2)</dt>
+<dd>last row, and first and last columns are closed. </dd> 
+@image html perio2_20.png 
+@image latex perio2_20.png
+<dt>North fold boundary with a T -point pivot (in_perio=3)</dt>
+<dd>first row, and first and last columns are closed. </dd> 
+@image html perio3_20.png 
+@image latex perio3_20.png
+<dt>North fold boundary with a T -point pivot and cyclic east-west boundary (in_perio=4)</dt>
+<dd>first row is closed. The first column is set to the value of the last-but-one column and the last column to the value of the second one. </dd> 
+@image html perio4_20.png 
+@image latex perio4_20.png
+<dt>North fold boundary with a F -point pivot (in_perio=5)</dt>
+<dd>first row, and first and last columns are closed. </dd> 
+@image html perio5_20.png 
+@image latex perio5_20.png
+<dt>North fold boundary with a F -point pivot and cyclic east-west boundary (in_perio=6)</dt>
+<dd>first row is closed. The first column is set to the value of the last-but-one column and the last column to the value of the second one.</dd> 
+@image html perio6_20.png 
+@image latex perio6_20.png
+</dl>
+@sa For more information about NEMO periodicity, see _Model Boundary Condition_ chapter in [NEMO documentation](http://www.nemo-ocean.eu/About-NEMO/Reference-manuals))
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/docsrc/main.dox
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/docsrc/main.dox	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/docsrc/main.dox	(revision 6440)
@@ -1,41 +1,32 @@
 /*!
- @mainpage Main Page
- @section descr Generic Description
- SIREN is a software to create regional configuration with
- [NEMO](http://www.nemo-ocean.eu).<br/> 
+ @mainpage About 
+
+ SIREN is a software to create regional configuration with [NEMO](http://www.nemo-ocean.eu).<br/> 
  Actually SIREN create input files needed for a basic NEMO configuration.<br/>
+
+ SIREN allows you to create your own regional configuration embedded in a wider one.<br/>
+ In order to help you, a set of GLORYS files (global reanalysis on ORCA025 grid), as well as examples
+ of namelists are available in dods repository.
+
+ @note This software was created, and is maintain by the Configuration Manager Working Group, composed
+ of NEMO system team members.
  
- SIREN is composed of a set of 5 Fortran programs :
-   - create_coord.f90 to create fine grid coordinate file from coarse grid coordinate file.
-   - create_bathy.f90 to create fine grid bathymetry file over domain.
-   - merge_bathy.f90 to merge fine grid bathymetry with coarse grid bathymetry at boundaries.
-   - create_restart.f90 to create initial state file from coarse grid restart or standard outputs.
-   - create_boundary.f90 to create boundary condition from coarse grid standard outputs.
+ To know how to install SIREN see @ref md_docsrc_1_install.
 
-To install those programs see @ref md_docsrc_1_install.
-
- @note SIREN can not:
- - create global configuration
- - create configuarion around or close to north pole
- - change number of vertical level
- - change grid (horizontal or vertical)
-
- @section howto How to use
-   @subsection howto_coord to create fine grid coordinate file
-   see create_coord.f90
-   @subsection howto_bathy to create fine grid bathymetry
-   see create_bathy.f90
-   @subsection howto_merge to merge fine grid bathymetry
-   see merge_bathy.f90
-   @subsection howto_restart to create initial state file
-   see create_restart.f90
-   @subsection howto_boundary to create boundary condition
-   see create_boundary.f90
+ You could find a tutorial for a quick start with SIREN in @ref md_docsrc_2_quickstart.<br/>
+ For more information about how to use each component of SIREN
+ - see create_coord.f90 to create fine grid coordinate file
+ - see create_bathy.f90 to create fine grid bathymetry
+ - see merge_bathy.f90 to merge fine grid bathymetry
+ - see create_restart.f90 to create initial state file, or other fields.
+ - see create_boundary.F90 to create boundary condition
 
 <HR>
    <b>
    - @ref md_docsrc_1_install
-   - @ref md_docsrc_3_codingRules
-   - @ref md_docsrc_4_changeLog
+   - @ref md_docsrc_2_quickstart
+   - @ref md_docsrc_3_support_bug
+   - @ref md_docsrc_4_codingRules
+   - @ref md_docsrc_5_changeLog
    - @ref todo
    </b>
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/domain.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/domain.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/domain.f90	(revision 6440)
@@ -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,7 +1294,9 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013
+   !> @date November, 2013 - Initial version
    !> @date September, 2014
    !> - take into account number of ghost cell
+   !> @date February, 2016
+   !> - number of extra point is the MAX (not the MIN) of zero and asess value. 
    !
    !> @param[inout] td_dom domain strcuture
@@ -1342,5 +1346,5 @@
                   td_dom%i_imin      = td_dom%i_imin - td_dom%i_iextra(1)
                ELSE ! td_dom%i_imin - il_iext <= td_dom%i_ghost0(jp_I,1)*ip_ghost
-                  td_dom%i_iextra(1) = MIN(0, &
+                  td_dom%i_iextra(1) = MAX(0, &
                   &                         td_dom%i_imin - &
                   &                         td_dom%i_ghost0(jp_I,1)*ip_ghost -1)
@@ -1354,5 +1358,5 @@
                ELSE ! td_dom%i_imax + il_iext >= &
                     !  td_dom%t_dim0(1)%i_len - td_dom%i_ghost0(jp_I,2)*ip_ghost
-                  td_dom%i_iextra(2) = MIN(0, &
+                  td_dom%i_iextra(2) = MAX( 0, &
                   &                         td_dom%t_dim0(1)%i_len - &
                   &                         td_dom%i_ghost0(jp_I,2)*ip_ghost - &
@@ -1362,4 +1366,5 @@
 
             ELSE ! td_dom%i_ew0 >= 0
+
                ! EW cyclic
                IF( td_dom%i_imin - il_iext > 0 )THEN
@@ -1389,9 +1394,10 @@
             ! nothing to be done
          ELSE
+
             IF( td_dom%i_jmin - il_jext > td_dom%i_ghost0(jp_J,1)*ip_ghost )THEN
                td_dom%i_jextra(1) = il_jext
                td_dom%i_jmin      = td_dom%i_jmin - td_dom%i_jextra(1)
             ELSE ! td_dom%i_jmin - il_jext <= td_dom%i_ghost0(jp_J,1)*ip_ghost
-               td_dom%i_jextra(1) = MIN(0, &
+               td_dom%i_jextra(1) = MAX( 0, &
                &                         td_dom%i_jmin - &
                &                         td_dom%i_ghost0(jp_J,1)*ip_ghost - 1)
@@ -1405,5 +1411,5 @@
             ELSE ! td_dom%i_jmax + il_jext >= &
                  !  td_dom%t_dim0(2)%i_len - td_dom%i_ghost0(jp_J,2)*ip_ghost
-               td_dom%i_jextra(2) = MIN(0, &
+               td_dom%i_jextra(2) = MAX( 0, &
                &                         td_dom%t_dim0(2)%i_len - &
                &                         td_dom%i_ghost0(jp_J,2)*ip_ghost - &
@@ -1433,5 +1439,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_dom domain strcuture
@@ -1476,5 +1482,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 +1721,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_dom domain strcuture
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/extrap.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/extrap.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/extrap.f90	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/file.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/file.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/file.f90	(revision 6440)
@@ -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,8 +692,10 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date September, 2014
-   !> - add dimension to file if need be
+   !> - add dimension in file if need be
    !> - do not reorder dimension from variable, before put in file
+   !> @date September, 2015
+   !> - check variable dimension expected
    !
    !> @param[inout] td_file   file structure
@@ -692,5 +707,5 @@
       ! Argument      
       TYPE(TFILE), INTENT(INOUT) :: td_file
-      TYPE(TVAR) , INTENT(IN   ) :: td_var
+      TYPE(TVAR) , INTENT(INOUT) :: td_var
 
       ! local variable
@@ -707,7 +722,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 +738,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 +755,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)//&
@@ -746,4 +762,7 @@
                ! check used dimension 
                IF( file_check_var_dim(td_file, td_var) )THEN
+
+                  ! check variable dimension expected
+                  CALL var_check_dim(td_var)
 
                   ! update dimension if need be
@@ -770,6 +789,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 +823,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 +910,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 +926,5 @@
       ! local variable
       INTEGER(i4)       :: il_ind
+      TYPE(TVAR)        :: tl_var
       !----------------------------------------------------------------
 
@@ -928,9 +948,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 +974,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_file   file structure
@@ -1034,5 +1055,4 @@
                   ! new number of variable in file
                   td_file%i_nvar=td_file%i_nvar-1
-
                   SELECT CASE(td_var%i_ndim)
                      CASE(0)
@@ -1096,5 +1116,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1131,5 +1151,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1247,5 +1267,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 +1284,5 @@
       ! local variable
       INTEGER(i4)       :: il_ind
+      TYPE(TATT)        :: tl_att
       !----------------------------------------------------------------
 
@@ -1282,9 +1306,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 +1330,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1403,5 +1428,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1444,5 +1469,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 +1554,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1609,5 +1634,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1652,5 +1677,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -1717,5 +1742,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 +1755,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_file   file structure
@@ -1769,5 +1794,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 +1833,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 +1852,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -1879,5 +1915,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -1906,5 +1942,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -2019,5 +2055,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   array of file structure
@@ -2057,5 +2093,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !
    !> @param[in] td_file   array of file 
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/filter.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/filter.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/filter.f90	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/function.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/function.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/function.f90	(revision 6440)
@@ -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
@@ -356,5 +363,5 @@
       IF( id_status /= 0 )THEN
          !CALL ERRSNS() ! not F95 standard
-         PRINT *, "FORTRAN ERROR"
+         PRINT *, "FORTRAN ERROR ",id_status
          !STOP
       ENDIF
@@ -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 real number
+   !-------------------------------------------------------------------
+   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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/global.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/global.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/global.f90	(revision 6440)
@@ -12,4 +12,6 @@
 ! REVISION HISTORY:
 !> @date November, 2013 - Initial Version
+!> @date September, 2015
+!> - define fill value for each variable type
 !
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -95,5 +97,9 @@
    &     'gauss      '/)
 
-   REAL(dp)                                , PARAMETER :: dp_fill=NF90_FILL_DOUBLE !< default fill value
+   REAL(dp)                                , PARAMETER :: dp_fill_i1=NF90_FILL_BYTE   !< byte fill value
+   REAL(dp)                                , PARAMETER :: dp_fill_i2=NF90_FILL_SHORT  !< short fill value
+   REAL(dp)                                , PARAMETER :: dp_fill_i4=NF90_FILL_INT    !< INT fill value
+   REAL(dp)                                , PARAMETER :: dp_fill_sp=NF90_FILL_FLOAT  !< real fill value
+   REAL(dp)                                , PARAMETER :: dp_fill=NF90_FILL_DOUBLE !< double fill value
 
    INTEGER(i4)                             , PARAMETER :: ip_npoint=4
@@ -125,5 +131,5 @@
    INTEGER(i4), PARAMETER :: jp_west =4
 
-
+   INTEGER(i4)                             , PARAMETER :: ip_maxdum = 10 !< maximum dummy variable, dimension, attribute
 
 END MODULE global
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/grid.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/grid.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/grid.f90	(revision 6440)
@@ -80,5 +80,6 @@
 !> point:<br/>
 !> @code
-!>    il_index(:)=grid_get_closest(dd_lon0(:,:), dd_lat0(:,:), dd_lon1, dd_lat1)
+!>    il_index(:)=grid_get_closest(dd_lon0(:,:), dd_lat0(:,:), dd_lon1, dd_lat1
+!>                                 [,dd_fill] [,cd_pos])
 !> @endcode
 !>       - il_index(:) is  coarse grid indices (/ i0, j0 /)
@@ -87,4 +88,6 @@
 !>       - dd_lon1 is fine grid longitude value (real(8))
 !>       - dd_lat1 is fine grid latitude  value (real(8))
+!>       - dd_fill
+!>       - cd_pos
 !>
 !>    to compute distance between a point A and grid points:<br/>
@@ -149,5 +152,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 +164,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 +216,9 @@
 !> @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
+!> @February, 2016
+!> - improve way to check coincidence (bug fix)
+!> - manage grid cases for T,U,V or F point, with even or odd refinment (bug fix)
 !
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -255,4 +263,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 +361,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 +475,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 +505,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 +533,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 +546,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 +552,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 +558,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 +610,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.
@@ -655,5 +670,5 @@
             
             ! no pivot point found
-            CALL logger_error("GRID GET PIVOT: something wrong "//&
+            CALL logger_warn("GRID GET PIVOT: something wrong "//&
             &  "when computing pivot point with variable "//&
             &  TRIM(td_var%c_name))
@@ -676,5 +691,5 @@
 
                IF( grid__get_pivot_var /= -1 )THEN
-                  CALL logger_warn("GRID GET PIVOT: variable "//&
+                  CALL logger_info("GRID GET PIVOT: variable "//&
                   &  TRIM(td_var%c_name)//" seems to be on grid point "//&
                   &  TRIM(cp_grid_point(jj)) )
@@ -708,5 +723,5 @@
    !> 
    !> @author J.Paul
-   !> - October, 2014 - Initial version
+   !> @date October, 2014 - Initial version
    !
    !> @param[in] dd_value array of value
@@ -783,5 +798,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 +816,5 @@
    !> 
    !> @author J.Paul
-   !> - October, 2014 - Initial version
+   !> @date October, 2014 - Initial version
    !
    !> @param[in] dd_value array of value
@@ -876,5 +891,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 +909,5 @@
    !> 
    !> @author J.Paul
-   !> - October, 2014 - Initial version
+   !> @date October, 2014 - Initial version
    !
    !> @param[in] dd_value array of value
@@ -969,5 +984,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 +1002,5 @@
    !> 
    !> @author J.Paul
-   !> - October, 2014 - Initial version
+   !> @date October, 2014 - Initial version
    !
    !> @param[in] dd_value array of value
@@ -1062,5 +1077,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 +1098,5 @@
    !>
    !> @author J.Paul
-   !> - Ocotber, 2014- Initial version
+   !> @date Ocotber, 2014 - Initial version
    !
    !> @param[in] td_file file structure
@@ -1172,5 +1187,5 @@
    !>
    !> @author J.Paul
-   !> - October, 2014 - Initial version
+   !> @date October, 2014 - Initial version
    !
    !> @param[in] td_mpp   mpp file structure
@@ -1277,13 +1292,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
@@ -1326,7 +1341,7 @@
          il_dim(:)=td_var%t_dim(:)%i_len
 
-         CALL logger_info("GRID GET PERIO: use varibale "//TRIM(td_var%c_name))
-         CALL logger_info("GRID GET PERIO: fill value "//TRIM(fct_str(td_var%d_fill)))
-         CALL logger_info("GRID GET PERIO: fill value "//TRIM(fct_str(td_var%d_value(1,1,1,1))))
+         CALL logger_debug("GRID GET PERIO: use varibale "//TRIM(td_var%c_name))
+         CALL logger_debug("GRID GET PERIO: fill value "//TRIM(fct_str(td_var%d_fill)))
+         CALL logger_debug("GRID GET PERIO: first value "//TRIM(fct_str(td_var%d_value(1,1,1,1))))
 
          IF(ALL(td_var%d_value(    1    ,    :    ,1,1)/=td_var%d_fill).AND.&
@@ -1335,7 +1350,18 @@
          &  ALL(td_var%d_value(    :    ,il_dim(2),1,1)/=td_var%d_fill))THEN
          ! no boundary closed
-            CALL logger_warn("GRID GET PERIO: can't determined periodicity. "//&
+            CALL logger_error("GRID GET PERIO: can't determined periodicity. "//&
             &             "there is no boundary closed for variable "//&
             &              TRIM(td_var%c_name) )
+            ! check pivot
+            SELECT CASE(id_pivot)
+               CASE(0)
+                  ! F pivot
+                  CALL logger_warn("GRID GET PERIO: assume domain is global")
+                  grid__get_perio_var=6
+               CASE(1)
+                  ! T pivot
+                  CALL logger_warn("GRID GET PERIO: assume domain is global")
+                  grid__get_perio_var=4
+            END SELECT
          ELSE
             ! check periodicity
@@ -1452,5 +1478,5 @@
    !>
    !> @author J.Paul
-   !> - October, 2014 - Initial version
+   !> @date October, 2014 - Initial version
    !>
    !> @param[in] td_file   file structure
@@ -1537,13 +1563,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 +1660,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 +1772,5 @@
    !>
    !> @author J.Paul
-   !> - October, 2014- Initial Version
+   !> @date October, 2014 - Initial Version
    !>
    !> @param[in] td_file file structure 
@@ -1797,5 +1823,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 +1879,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] td_lat latitude variable structure 
@@ -1890,5 +1916,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 +2004,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 +2033,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 +2087,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 +2122,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 +2187,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 +2217,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 +2274,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))
          
@@ -2224,5 +2304,4 @@
          &                                                    il_rho(:), cl_point )
 
-         
          CALL var_clean(tl_lon1)
          CALL var_clean(tl_lat1)         
@@ -2244,9 +2323,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 +2353,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 +2413,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,8 +2475,11 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date September, 2014
    !> - check grid point
    !> - take into account EW overlap
+   !> @date February, 2016
+   !> - use delta (lon or lat)
+   !> - manage cases for T,U,V or F point, with even or odd refinment
    !>
    !> @param[in] td_lon0   coarse grid longitude
@@ -2408,54 +2509,49 @@
 
       ! local variable
-      REAL(dp)    :: dl_lon1_ll
-      REAL(dp)    :: dl_lon1_ul
-      REAL(dp)    :: dl_lon1_lr
-      REAL(dp)    :: dl_lon1_ur
-
-      REAL(dp)    :: dl_lat1_ll
-      REAL(dp)    :: dl_lat1_ul
-      REAL(dp)    :: dl_lat1_lr
-      REAL(dp)    :: dl_lat1_ur
+      CHARACTER(LEN= 1)                      :: cl_point0
+      CHARACTER(LEN= 1)                      :: cl_point1
+
+      LOGICAL    , DIMENSION(2)              :: ll_even
+
+      REAL(dp)                               :: dl_lon1
+      REAL(dp)                               :: dl_dlon
+      REAL(dp)                               :: dl_lat1
+      REAL(dp)                               :: dl_dlat
+
+      INTEGER(i4)                            :: il_ew0 
+      INTEGER(i4)                            :: il_imin0
+      INTEGER(i4)                            :: il_imax0
+      INTEGER(i4)                            :: il_jmin0
+      INTEGER(i4)                            :: il_jmax0
+
+      INTEGER(i4)                            :: il_ew1 
+      INTEGER(i4)                            :: il_imin1
+      INTEGER(i4)                            :: il_imax1
+      INTEGER(i4)                            :: il_jmin1
+      INTEGER(i4)                            :: il_jmax1
+
+      INTEGER(i4)                            :: il_imin
+      INTEGER(i4)                            :: il_imax
+      INTEGER(i4)                            :: il_jmin
+      INTEGER(i4)                            :: il_jmax      
 
       INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho
 
-      INTEGER(i4), DIMENSION(2) :: il_ill
-      INTEGER(i4), DIMENSION(2) :: il_ilr
-      INTEGER(i4), DIMENSION(2) :: il_iul
-      INTEGER(i4), DIMENSION(2) :: il_iur
-
-      INTEGER(i4) :: il_ew0 
-      INTEGER(i4) :: il_imin0
-      INTEGER(i4) :: il_imax0
-      INTEGER(i4) :: il_jmin0
-      INTEGER(i4) :: il_jmax0
-
-      INTEGER(i4) :: il_ew1 
-      INTEGER(i4) :: il_imin1
-      INTEGER(i4) :: il_imax1
-      INTEGER(i4) :: il_jmin1
-      INTEGER(i4) :: il_jmax1
-
-      INTEGER(i4) :: il_imin
-      INTEGER(i4) :: il_imax
-      INTEGER(i4) :: il_jmin
-      INTEGER(i4) :: il_jmax      
-
-      INTEGER(i4), DIMENSION(2,2) :: il_xghost0
-      INTEGER(i4), DIMENSION(2,2) :: il_yghost0
-      INTEGER(i4), DIMENSION(2,2) :: il_xghost1
-      INTEGER(i4), DIMENSION(2,2) :: il_yghost1
-
-      TYPE(TVAR) :: tl_lon0
-      TYPE(TVAR) :: tl_lat0
-      TYPE(TVAR) :: tl_lon1
-      TYPE(TVAR) :: tl_lat1
-
-      CHARACTER(LEN= 1) :: cl_point0
-      CHARACTER(LEN= 1) :: cl_point1
-      
+      INTEGER(i4), DIMENSION(2)              :: il_ill
+      INTEGER(i4), DIMENSION(2)              :: il_ilr
+      INTEGER(i4), DIMENSION(2)              :: il_iul
+      INTEGER(i4), DIMENSION(2)              :: il_iur
+
+      INTEGER(i4), DIMENSION(2,2)            :: il_xghost0
+      INTEGER(i4), DIMENSION(2,2)            :: il_yghost0
+      INTEGER(i4), DIMENSION(2,2)            :: il_xghost1
+      INTEGER(i4), DIMENSION(2,2)            :: il_yghost1
+
+      TYPE(TVAR)                             :: tl_lon0
+      TYPE(TVAR)                             :: tl_lat0
+      TYPE(TVAR)                             :: tl_lon1
+      TYPE(TVAR)                             :: tl_lat1
+
       ! loop indices
-      INTEGER(i4) :: ji
-      INTEGER(i4) :: jj
       !----------------------------------------------------------------
       ! init
@@ -2465,4 +2561,6 @@
       il_rho(:)=1
       IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:)
+
+      ll_even(:)=(/ (MOD(id_rho(jp_I),2)==0), (MOD(id_rho(jp_J),2)==0) /)
 
       cl_point0='T'
@@ -2520,5 +2618,5 @@
             CALL grid_del_ghost(tl_lon0, il_xghost0(:,:))
             CALL grid_del_ghost(tl_lat0, il_xghost0(:,:))
-            
+ 
             ! "global" coarse grid indice
             il_imin0=1
@@ -2563,13 +2661,53 @@
             ! get indices for each corner
             !1- search lower left corner indices
-            dl_lon1_ll=tl_lon1%d_value( il_imin1, il_jmin1, 1, 1 )
-            dl_lat1_ll=tl_lat1%d_value( il_imin1, il_jmin1, 1, 1 )
-
-            IF( dl_lon1_ll == tl_lon1%d_fill .OR. &
-            &   dl_lat1_ll == tl_lat1%d_fill )THEN
+            dl_lon1=tl_lon1%d_value( il_imin1, il_jmin1, 1, 1 )
+            dl_lat1=tl_lat1%d_value( il_imin1, il_jmin1, 1, 1 )
+
+            IF( dl_lon1 == tl_lon1%d_fill .OR. &
+            &   dl_lat1 == tl_lat1%d_fill )THEN
                CALL logger_error("GRID GET COARSE INDEX: lower left corner "//&
                &                 "point is FillValue. remove ghost cell "//&
                &                 "before running grid_get_coarse_index.")
             ENDIF
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point1))
+                  CASE('F','U')
+                     dl_dlon= ( tl_lon1%d_value(il_imin1+1,il_jmin1,1,1) -   &
+                        &       tl_lon1%d_value(il_imin1  ,il_jmin1,1,1) ) / &
+                        &     2.
+                  CASE DEFAULT
+                     dl_dlon=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlon= ( tl_lon1%d_value(il_imin1+1,il_jmin1,1,1) -   &
+                  &       tl_lon1%d_value(il_imin1  ,il_jmin1,1,1) ) / &
+                  &     2.
+            ENDIF
+
+            !!!!! j-direction !!!!!
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point1))
+                  CASE('F','V')
+                     dl_dlat= ( tl_lat1%d_value(il_imin1,il_jmin1+1,1,1) -   &
+                        &       tl_lat1%d_value(il_imin1,il_jmin1  ,1,1) ) / &
+                        &     2.
+                  CASE DEFAULT
+                     dl_dlat=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlat= ( tl_lat1%d_value(il_imin1,il_jmin1+1,1,1) -   &
+                  &       tl_lat1%d_value(il_imin1,il_jmin1  ,1,1) ) / &
+                  &     2.
+            ENDIF
+
+            dl_lon1 = dl_lon1 + dl_dlon
+            dl_lat1 = dl_lat1 + dl_dlat
+
             ! look for closest point on coarse grid
             il_ill(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, &
@@ -2579,45 +2717,57 @@
             &                                           il_jmin0:il_jmax0, &
             &                                           1,1), &
-            &                           dl_lon1_ll, dl_lat1_ll   )
-
-            ! coarse grid point should be south west of fine grid domain
-            ji = il_ill(1)
-            jj = il_ill(2)
-
-            IF( ABS(tl_lon0%d_value(ji,jj,1,1)-dl_lon1_ll) > dp_delta )THEN
-               IF(tl_lon0%d_value(ji,jj,1,1) > dl_lon1_ll )THEN
-                  il_ill(1)=il_ill(1)-1
-                  IF( il_ill(1) <= 0 )THEN
-                     IF( tl_lon0%i_ew >= 0 )THEN
-                        il_ill(1)=tl_lon0%t_dim(jp_I)%i_len-tl_lon0%i_ew
-                     ELSE
-                        CALL logger_error("GRID GET COARSE INDEX: error "//&
-                        &                 "computing lower left corner "//&
-                        &                 "index for longitude")
-                     ENDIF
-                  ENDIF
-               ENDIF
-            ENDIF
-            IF( ABS(tl_lat0%d_value(ji,jj,1,1)-dl_lat1_ll) > dp_delta )THEN
-               IF(tl_lat0%d_value(ji,jj,1,1) > dl_lat1_ll )THEN
-                  il_ill(2)=il_ill(2)-1
-                  IF( il_ill(2)-1 <= 0 )THEN
-                     CALL logger_error("GRID GET COARSE INDEX: error "//&
-                     &                 "computing lower left corner "//&
-                     &                 "index for latitude")
-                  ENDIF
-               ENDIF
-            ENDIF
+            &                           dl_lon1, dl_lat1, 'll'   )
+
 
             !2- search upper left corner indices
-            dl_lon1_ul=tl_lon1%d_value( il_imin1, il_jmax1, 1, 1 )
-            dl_lat1_ul=tl_lat1%d_value( il_imin1, il_jmax1, 1, 1 )
-
-            IF( dl_lon1_ul == tl_lon1%d_fill .OR. &
-            &   dl_lat1_ul == tl_lat1%d_fill )THEN
+            dl_lon1=tl_lon1%d_value( il_imin1, il_jmax1, 1, 1 )
+            dl_lat1=tl_lat1%d_value( il_imin1, il_jmax1, 1, 1 )
+
+            IF( dl_lon1 == tl_lon1%d_fill .OR. &
+            &   dl_lat1 == tl_lat1%d_fill )THEN
                CALL logger_error("GRID GET COARSE INDEX: upper left corner "//&
                &                 "point is FillValue. remove ghost cell "//&
                &                 "running grid_get_coarse_index.")
             ENDIF            
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point1))
+                  CASE('F','U')
+                     dl_dlon= ( tl_lon1%d_value(il_imin1+1,il_jmax1,1,1) -   &
+                        &       tl_lon1%d_value(il_imin1  ,il_jmax1,1,1) ) / &
+                        &     2.
+                  CASE DEFAULT
+                     dl_dlon=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlon= ( tl_lon1%d_value(il_imin1+1,il_jmax1,1,1) -   &
+                  &       tl_lon1%d_value(il_imin1  ,il_jmax1,1,1) ) / &
+                  &     2.
+            ENDIF
+
+            !!!!! j-direction !!!!!
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point1))
+                  CASE('F','V')
+                     dl_dlat= ( tl_lat1%d_value(il_imin1,il_jmax1  ,1,1) -   &
+                        &       tl_lat1%d_value(il_imin1,il_jmax1-1,1,1) ) / &
+                        &     2.
+                  CASE DEFAULT
+                     dl_dlat=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlat= ( tl_lat1%d_value(il_imin1,il_jmax1  ,1,1) -   &
+                  &       tl_lat1%d_value(il_imin1,il_jmax1-1,1,1) ) / &
+                  &     2.
+            ENDIF
+
+            dl_lon1 = dl_lon1 + dl_dlon
+            dl_lat1 = dl_lat1 - dl_dlat
+
             ! look for closest point on coarse grid
             il_iul(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, &
@@ -2627,46 +2777,56 @@
             &                                           il_jmin0:il_jmax0, &
             &                                           1,1), &
-            &                           dl_lon1_ul, dl_lat1_ul   )
-
-            ! coarse grid point should be north west of fine grid domain
-            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
-                  il_iul(1)=il_iul(1)-1
-                  IF( il_iul(1) <= 0 )THEN
-                     IF( tl_lon0%i_ew >= 0 )THEN
-                        il_iul(1)=tl_lon0%t_dim(jp_I)%i_len-tl_lon0%i_ew
-                     ELSE
-                        CALL logger_error("GRID GET COARSE INDEX: error "//&
-                        &                 "computing upper left corner "//&
-                        &                 "index for longitude")
-                     ENDIF
-                  ENDIF
-               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
-                  il_iul(2)=il_iul(2)+1
-                  IF( il_ill(2) > tl_lat0%t_dim(jp_J)%i_len )THEN
-                     CALL logger_error("GRID GET COARSE INDEX: error "//&
-                     &                 "computing upper left corner "//&
-                     &                 "index for latitude")
-                  ENDIF
-               ENDIF
-            ENDIF
+            &                           dl_lon1, dl_lat1, 'ul' )
 
             !3- search lower right corner indices
-            dl_lon1_lr=tl_lon1%d_value( il_imax1, il_jmin1, 1, 1 )
-            dl_lat1_lr=tl_lat1%d_value( il_imax1, il_jmin1, 1, 1 )
-
-            IF( dl_lon1_lr == tl_lon1%d_fill .OR. &
-            &   dl_lat1_lr == tl_lat1%d_fill )THEN
+            dl_lon1=tl_lon1%d_value( il_imax1, il_jmin1, 1, 1 )
+            dl_lat1=tl_lat1%d_value( il_imax1, il_jmin1, 1, 1 )
+
+            IF( dl_lon1 == tl_lon1%d_fill .OR. &
+            &   dl_lat1 == tl_lat1%d_fill )THEN
                CALL logger_error("GRID GET COARSE INDEX: lower right corner "//&
                &                 "point is FillValue. remove ghost cell "//&
                &                 "running grid_get_coarse_index.")
             ENDIF            
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point1))
+                  CASE('F','U')
+                     dl_dlon= ( tl_lon1%d_value(il_imax1  ,il_jmin1,1,1) -   &
+                        &       tl_lon1%d_value(il_imax1-1,il_jmin1,1,1) ) / &
+                        &     2.
+                  CASE DEFAULT
+                     dl_dlon=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlon= ( tl_lon1%d_value(il_imax1  ,il_jmin1,1,1) -   &
+                  &       tl_lon1%d_value(il_imax1-1,il_jmin1,1,1) ) / &
+                  &     2.
+            ENDIF
+
+            !!!!! j-direction !!!!!
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point1))
+                  CASE('F','V')
+                     dl_dlat= ( tl_lat1%d_value(il_imax1,il_jmin1+1,1,1) -   &
+                        &       tl_lat1%d_value(il_imax1,il_jmin1  ,1,1) ) / &
+                        &     2.
+                  CASE DEFAULT
+                     dl_dlat=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlat= ( tl_lat1%d_value(il_imax1,il_jmin1+1,1,1) -   &
+                  &       tl_lat1%d_value(il_imax1,il_jmin1  ,1,1) ) / &
+                  &     2.
+            ENDIF
+
+            dl_lon1 = dl_lon1 - dl_dlon
+            dl_lat1 = dl_lat1 + dl_dlat
+
             ! look for closest point on coarse grid
             il_ilr(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, &
@@ -2676,44 +2836,56 @@
             &                                           il_jmin0:il_jmax0, &
             &                                           1,1), &
-            &                           dl_lon1_lr, dl_lat1_lr   )
-
-            ! coarse grid point should be south east of fine grid domain
-            ji = il_ilr(1)
-            jj = il_ilr(2)
-            IF( ABS(tl_lon0%d_value(ji,jj,1,1)-dl_lon1_lr) > dp_delta )THEN
-               IF( tl_lon0%d_value(ji,jj,1,1) < dl_lon1_lr )THEN
-                  il_ilr(1)=il_ilr(1)+1
-                  IF( il_ilr(1) > tl_lon0%t_dim(jp_I)%i_len )THEN
-                     IF( tl_lon0%i_ew >= 0 )THEN
-                        il_ilr(1)=tl_lon0%i_ew+1
-                     ELSE
-                        CALL logger_error("GRID GET COARSE INDEX: error "//&
-                        &                 "computing lower right corner "//&
-                        &                 "index for longitude")
-                     ENDIF
-                  ENDIF
-               ENDIF
-            ENDIF
-            IF( ABS(tl_lat0%d_value(ji,jj,1,1)-dl_lat1_lr) > dp_delta )THEN
-               IF( tl_lat0%d_value(ji,jj,1,1) > dl_lat1_lr )THEN
-                  il_ilr(2)=il_ilr(2)-1
-                  IF( il_ilr(2) <= 0 )THEN
-                     CALL logger_error("GRID GET COARSE INDEX: error "//&
-                     &                 "computing lower right corner "//&
-                     &                 "index for latitude")
-                  ENDIF
-               ENDIF
-            ENDIF
+            &                           dl_lon1, dl_lat1, 'lr' )
 
             !4- search upper right corner indices
-            dl_lon1_ur=tl_lon1%d_value( il_imax1, il_jmax1, 1, 1 )
-            dl_lat1_ur=tl_lat1%d_value( il_imax1, il_jmax1, 1, 1 )
-
-            IF( dl_lon1_ur == tl_lon1%d_fill .OR. &
-            &   dl_lat1_ur == tl_lat1%d_fill )THEN
+            dl_lon1=tl_lon1%d_value( il_imax1, il_jmax1, 1, 1 )
+            dl_lat1=tl_lat1%d_value( il_imax1, il_jmax1, 1, 1 )
+
+            IF( dl_lon1 == tl_lon1%d_fill .OR. &
+            &   dl_lat1 == tl_lat1%d_fill )THEN
                CALL logger_error("GRID GET COARSE INDEX: upper right corner "//&
                &                 "point is FillValue. remove ghost cell "//&
-               &                 "running grid_get_coarse_index.")
+               &                 "before running grid_get_coarse_index.")
             ENDIF            
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point1))
+                  CASE('F','U')
+                     dl_dlon= ( tl_lon1%d_value(il_imax1  ,il_jmax1,1,1) -   &
+                        &       tl_lon1%d_value(il_imax1-1,il_jmax1,1,1) ) / &
+                        &     2.
+                  CASE DEFAULT
+                     dl_dlon=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlon= ( tl_lon1%d_value(il_imax1  ,il_jmax1,1,1) -   &
+                  &       tl_lon1%d_value(il_imax1-1,il_jmax1,1,1) ) / &
+                  &     2.
+            ENDIF
+
+            !!!!! j-direction !!!!!
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point1))
+                  CASE('F','V')
+                     dl_dlat= ( tl_lat1%d_value(il_imax1,il_jmax1  ,1,1) -   &
+                        &       tl_lat1%d_value(il_imax1,il_jmax1-1,1,1) ) / &
+                        &     2.
+                  CASE DEFAULT
+                     dl_dlat=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlat= ( tl_lat1%d_value(il_imax1,il_jmax1  ,1,1) -   &
+                  &       tl_lat1%d_value(il_imax1,il_jmax1-1,1,1) ) / &
+                  &     2.
+            ENDIF
+
+            dl_lon1 = dl_lon1 - dl_dlon
+            dl_lat1 = dl_lat1 - dl_dlat
+
             ! look for closest point on coarse grid
             il_iur(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, &
@@ -2723,33 +2895,5 @@
             &                                           il_jmin0:il_jmax0, &
             &                                           1,1), &
-            &                           dl_lon1_ur, dl_lat1_ur   )
-
-            ! coarse grid point should be north east fine grid domain
-            ji = il_iur(1)
-            jj = il_iur(2)
-            IF( ABS(tl_lon0%d_value(ji,jj,1,1)-dl_lon1_ur) > dp_delta )THEN
-               IF( tl_lon0%d_value(ji,jj,1,1) < dl_lon1_ur )THEN
-                  il_iur(1)=il_iur(1)+1
-                  IF( il_iur(1) > tl_lon0%t_dim(jp_I)%i_len )THEN
-                     IF( tl_lon0%i_ew >= 0 )THEN
-                        il_iur(1)=tl_lon0%i_ew+1
-                     ELSE
-                        CALL logger_error("GRID GET COARSE INDEX: error "//&
-                        &                 "computing upper right corner "//&
-                        &                 "index for longitude")
-                     ENDIF
-                  ENDIF
-               ENDIF
-            ENDIF
-            IF( ABS(tl_lat0%d_value(ji,jj,1,1)-dl_lat1_ur) > dp_delta )THEN
-               IF( tl_lat0%d_value(ji,jj,1,1) < dl_lat1_ur )THEN
-                  il_iur(2)=il_iur(2)+1
-                  IF( il_iur(2) > tl_lat0%t_dim(jp_J)%i_len )THEN
-                     CALL logger_error("GRID GET COARSE INDEX: error "//&
-                     &                 "computing upper right corner "//&
-                     &                 "index for latitude")
-                  ENDIF
-               ENDIF
-            ENDIF
+            &                           dl_lon1, dl_lat1, 'ur' )
 
             ! coarse grid indices
@@ -2798,5 +2942,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_lon longitude structure 
@@ -2857,6 +3001,6 @@
    END FUNCTION grid_is_global
    !-------------------------------------------------------------------
-   !> @brief This function return coarse grid indices of the closest point
-   !> from fine grid point (lon1,lat1) 
+   !> @brief This function return grid indices of the closest point
+   !> from point (lon1,lat1) 
    !> 
    !> @details
@@ -2865,6 +3009,20 @@
    !> of longitude and latitude, before running this function
    !>
+   !> if you add cd_pos argument, you could choice to return closest point at
+   !> - lower left  (ll) of the point
+   !> - lower right (lr) of the point
+   !> - upper left  (ul) of the point
+   !> - upper right (ur) of the point
+   !> - lower       (lo) of the point
+   !> - upper       (up) of the point
+   !> -       left  (le) of the point
+   !> -       right (ri) of the point
+   !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2015
+   !> - change dichotomy method to manage ORCA grid
+   !> @date February, 2016
+   !> - add optional use of relative position
    !
    !> @param[in] dd_lon0   coarse grid array of longitude
@@ -2872,8 +3030,9 @@
    !> @param[in] dd_lon1   fine   grid longitude
    !> @param[in] dd_lat1   fine   grid latitude
+   !> @param[in] cd_pos    relative position of grid point from point 
+   !> @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, cd_pos, dd_fill )
       IMPLICIT NONE
       ! Argument
@@ -2882,4 +3041,6 @@
       REAL(dp),                 INTENT(IN) :: dd_lon1
       REAL(dp),                 INTENT(IN) :: dd_lat1
+      CHARACTER(LEN=*),         INTENT(IN), OPTIONAL :: cd_pos
+      REAL(dp),                 INTENT(IN), OPTIONAL :: dd_fill
 
       ! function
@@ -2929,46 +3090,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 +3162,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 +3169,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 +3203,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
@@ -3034,4 +3220,45 @@
       &                          dl_lon1, dd_lat1 )
 
+      IF( PRESENT(cd_pos) )THEN
+         ! 
+         SELECT CASE(TRIM(cd_pos))
+            CASE('le')
+               WHERE( dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) > dd_lat1 )
+                  dl_dist(:,:)=NF90_FILL_DOUBLE
+               END WHERE
+            CASE('ri')
+               WHERE( dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) < dd_lat1 )
+                  dl_dist(:,:)=NF90_FILL_DOUBLE
+               END WHERE
+            CASE('up')
+               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) < dl_lon1 )
+                  dl_dist(:,:)=NF90_FILL_DOUBLE
+               END WHERE
+            CASE('lo')
+               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) > dl_lon1 )
+                  dl_dist(:,:)=NF90_FILL_DOUBLE
+               END WHERE
+            CASE('ll')
+               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) > dl_lon1 .OR. &
+                    & dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) > dd_lat1 )
+                  dl_dist(:,:)=NF90_FILL_DOUBLE
+               END WHERE
+            CASE('lr')
+               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) < dl_lon1 .OR. &
+                    & dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) > dd_lat1 )
+                  dl_dist(:,:)=NF90_FILL_DOUBLE
+               END WHERE               
+            CASE('ul')
+               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) > dl_lon1 .OR. &
+                    & dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) < dd_lat1 )
+                  dl_dist(:,:)=NF90_FILL_DOUBLE
+               END WHERE               
+            CASE('ur')
+               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) < dl_lon1 .OR. &
+                    & dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) < dd_lat1 )
+                  dl_dist(:,:)=NF90_FILL_DOUBLE
+               END WHERE
+         END SELECT
+      ENDIF
       grid_get_closest(:)=MINLOC(dl_dist(:,:),dl_dist(:,:)/=NF90_FILL_DOUBLE)
 
@@ -3049,5 +3276,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] dd_lon    grid longitude array
@@ -3055,7 +3282,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 +3338,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 +3365,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 +3399,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 +3418,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 +3457,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 +3512,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))
  
@@ -3297,5 +3557,5 @@
          &                                         il_imax0, il_jmax0, &
          &                                         dl_lon1(:,:), dl_lat1(:,:),&
-         &                                         id_rho(:) )
+         &                                         id_rho(:), cl_point )
  
          DEALLOCATE(dl_lon0, dl_lat0)
@@ -3318,5 +3578,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 +3614,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 +3657,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))
  
@@ -3427,5 +3702,5 @@
          &                                         id_imax0, id_jmax0, &
          &                                         dl_lon1(:,:), dl_lat1(:,:),&
-         &                                         id_rho(:) )
+         &                                         id_rho(:), cl_point )
          
          DEALLOCATE(dl_lon1, dl_lat1)
@@ -3446,5 +3721,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,28 +3758,28 @@
 
       ! 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
       !----------------------------------------------------------------
       ! init
       grid__get_fine_offset_fc(:,:)=-1
-
       ALLOCATE(il_rho(ip_maxdim))
       il_rho(:)=1
@@ -3528,10 +3803,25 @@
          CALL iom_mpp_open(tl_coord0)
 
-         ! read coarse longitue and latitude
+         ! read coarse longitude 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))
-         
+ 
          ! close mpp files
          CALL iom_mpp_close(tl_coord0)
@@ -3539,4 +3829,5 @@
          CALL grid_del_ghost(tl_lon0, il_xghost0(:,:))
          CALL grid_del_ghost(tl_lat0, il_xghost0(:,:))
+
 
          ALLOCATE(dl_lon0(tl_lon0%t_dim(jp_I)%i_len, &
@@ -3561,5 +3852,4 @@
          il_jmax0=id_jmax0-il_xghost0(jp_J,1)
 
-      
          !3- compute
          grid__get_fine_offset_fc(:,:)=grid_get_fine_offset(&
@@ -3568,5 +3858,5 @@
          &                                         il_imax0, il_jmax0, &
          &                                         dd_lon1(:,:), dd_lat1(:,:),&
-         &                                         id_rho(:) )
+         &                                         id_rho(:), cl_point )
          
          DEALLOCATE(dl_lon0, dl_lat0)
@@ -3585,7 +3875,20 @@
    !
    !> @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
+   !> @date July, 2015
+   !> - manage case close to greenwich meridian
+   !> @date February, 2016
+   !> - use grid_get_closest to assess offset
+   !> - use delta (lon or lat)
+   !> - manage cases for T,U,V or F point, with even or odd refinment
+   !> - check lower left(upper right) fine grid point inside lower left(upper
+   !> right) coarse grid cell.
+   !> 
+   !> @todo check case close from North fold.
+   !>
    !> @param[in] dd_lon0   coarse grid longitude array 
    !> @param[in] dd_lat0   coarse grid latitude  array
@@ -3597,22 +3900,24 @@
    !> @param[in] dd_lat1   fine   grid latitude  array
    !> @param[in] id_rho    array of refinement factor
+   !> @param[in] cd_point  Arakawa grid point
    !> @return offset array (/ (/i_offset_left,i_offset_right/),(/j_offset_lower,j_offset_upper/) /)
    !-------------------------------------------------------------------
    FUNCTION grid__get_fine_offset_cc( dd_lon0, dd_lat0, &
    &                                  id_imin0, id_jmin0, id_imax0, id_jmax0, &
-   &                                  dd_lon1, dd_lat1, id_rho )
+   &                                  dd_lon1, dd_lat1, id_rho, cd_point )
       IMPLICIT NONE
       ! Argument
-      REAL(dp)   , DIMENSION(:,:), INTENT(IN) :: dd_lon0
-      REAL(dp)   , DIMENSION(:,:), INTENT(IN) :: dd_lat0
-      REAL(dp)   , DIMENSION(:,:), INTENT(IN) :: dd_lon1
-      REAL(dp)   , DIMENSION(:,:), INTENT(IN) :: dd_lat1
-
-      INTEGER(i4),                 INTENT(IN) :: id_imin0
-      INTEGER(i4),                 INTENT(IN) :: id_jmin0
-      INTEGER(i4),                 INTENT(IN) :: id_imax0
-      INTEGER(i4),                 INTENT(IN) :: id_jmax0
-
-      INTEGER(i4), DIMENSION(:)  , INTENT(IN) :: id_rho
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN) :: dd_lon0
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN) :: dd_lat0
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN) :: dd_lon1
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN) :: dd_lat1
+
+      INTEGER(i4)     ,                 INTENT(IN) :: id_imin0
+      INTEGER(i4)     ,                 INTENT(IN) :: id_jmin0
+      INTEGER(i4)     ,                 INTENT(IN) :: id_imax0
+      INTEGER(i4)     ,                 INTENT(IN) :: id_jmax0
+
+      INTEGER(i4)     , DIMENSION(:)  , INTENT(IN) :: id_rho
+      CHARACTER(LEN=*)                , INTENT(IN), OPTIONAL :: cd_point
 
       ! function
@@ -3620,13 +3925,33 @@
 
       ! local variable
-      INTEGER(i4), DIMENSION(2) :: il_shape0
-      INTEGER(i4), DIMENSION(2) :: il_shape1
+      CHARACTER(LEN= 1)                        :: cl_point
+
+      INTEGER(i4)                              :: i1
+      INTEGER(i4)                              :: i2
+      INTEGER(i4)                              :: j1
+      INTEGER(i4)                              :: j2
+
+      INTEGER(i4), DIMENSION(2)                :: il_shape0
+      INTEGER(i4), DIMENSION(2)                :: il_shape1
+
+      INTEGER(i4), DIMENSION(2)                :: il_ind
+
       REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0
       REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon1
+
+      REAL(dp)                                 :: dl_lonmax0
+      REAL(dp)                                 :: dl_latmax0
+      REAL(dp)                                 :: dl_lonmin0
+      REAL(dp)                                 :: dl_latmin0
+
+      REAL(dp)                                 :: dl_lon0F
+      REAL(dp)                                 :: dl_lat0F
+      REAL(dp)                                 :: dl_dlon
+      REAL(dp)                                 :: dl_dlat
+
+      LOGICAL    , DIMENSION(2)                :: ll_even
+      LOGICAL                                  :: ll_greenwich
       
       ! loop indices
-      INTEGER(i4) :: ji
-      INTEGER(i4) :: jj
-
       INTEGER(i4) :: ii
       INTEGER(i4) :: ij
@@ -3640,88 +3965,557 @@
          CALL logger_fatal("GRID GET FINE OFFSET: dimension of fine "//&
          &              "longitude and latitude differ")
-      ENDIF      
+      ENDIF
+
+      ll_even(:)=(/ (MOD(id_rho(jp_I),2)==0), (MOD(id_rho(jp_J),2)==0) /)
+
+      cl_point='T'
+      IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point))
 
       il_shape0(:)=SHAPE(dd_lon0(:,:))
       ALLOCATE( dl_lon0(il_shape0(1),il_shape0(2)) )
 
+      il_shape1(:)=SHAPE(dd_lon1(:,:))
+      ALLOCATE( dl_lon1(il_shape1(1),il_shape1(2)) )
+
       dl_lon0(:,:)=dd_lon0(:,:)
       WHERE( dd_lon0(:,:) < 0 ) dl_lon0(:,:)=dd_lon0(:,:)+360.
 
-      il_shape1(:)=SHAPE(dd_lon1(:,:))
-      ALLOCATE( dl_lon1(il_shape1(1),il_shape1(2)) )
-
       dl_lon1(:,:)=dd_lon1(:,:)
-      WHERE( dd_lon1(:,:) < 0 ) dl_lon1(:,:)=dd_lon1(:,:)+360.         
+      WHERE( dd_lon1(:,:) < 0 ) dl_lon1(:,:)=dd_lon1(:,:)+360.
 
       ! init
       grid__get_fine_offset_cc(:,:)=-1
-
-      IF( il_shape1(1) > 1 )THEN
-
-         ! look for i-direction left offset 
-         IF( dl_lon1(1,1) < dl_lon0(id_imin0+1,id_jmin0) )THEN
-            DO ji=1,id_rho(jp_I)+2
-               IF( dl_lon1(ji,1) > dl_lon0(id_imin0+1,id_jmin0) - dp_delta )THEN
-                  grid__get_fine_offset_cc(1,1)=(id_rho(jp_I)+1)-ji
-                  EXIT
-               ENDIF
-            ENDDO
+      ll_greenwich=.FALSE.
+
+      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
+         i1=1 ; i2=MIN((id_rho(jp_I)+2),il_shape1(jp_I))
+         j1=1 ; j2=1
+
+         ! check if cross greenwich meridien
+         IF( minval(dl_lon0(id_imin0:id_imin0+1,id_jmin0))<5. .OR. &
+           & maxval(dl_lon0(id_imin0:id_imin0+1,id_jmin0))>355. )THEN
+            ! close to greenwich meridien
+            ll_greenwich=.TRUE.
+            ! 0:360 => -180:180
+            WHERE( dl_lon0(id_imin0:id_imin0+1,id_jmin0) > 180. )
+               dl_lon0(id_imin0:id_imin0+1,id_jmin0) = &
+                  & dl_lon0(id_imin0:id_imin0+1,id_jmin0)-360.
+            END WHERE
+
+            WHERE( dl_lon1(i1:i2,j1:j2) > 180. )
+               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)-360.
+            END WHERE
+         ENDIF
+
+         ! max lognitude of the left cell
+         dl_lonmax0=dl_lon0(id_imin0+1,id_jmin0)
+         IF( dl_lon1(1,1) < dl_lonmax0 )THEN
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('F','U')
+                     dl_dlon= ( dl_lon0(id_imin0+1,id_jmin0) -   &
+                        &       dl_lon0(id_imin0  ,id_jmin0) ) / &
+                        &     ( 2.*id_rho(jp_I) )
+                  CASE DEFAULT
+                     dl_dlon=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlon= ( dl_lon0(id_imin0+1,id_jmin0) -   &
+                  &       dl_lon0(id_imin0  ,id_jmin0) ) / &
+                  &     ( 2.*id_rho(jp_I) )
+            ENDIF
+
+            dl_lon0F= dl_lon0(id_imin0+1,id_jmin0) + dl_dlon
+            dl_lat0F= dd_lat0(id_imin0+1,id_jmin0)
+
+            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), &
+            &                           dl_lon0F, dl_lat0F, 'le' )
+      
+            ii=il_ind(1)
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('T','V')
+                     grid__get_fine_offset_cc(jp_I,1)=id_rho(jp_I)-ii
+                  CASE DEFAULT !'F','U' 
+                     grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii
+               END SELECT
+            ELSE
+               ! odd
+               grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii
+            ENDIF
+
          ELSE
             CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//&
-            &                 " 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
-            DO ji=1,id_rho(jp_I)+2
-               ii=il_shape1(1)-ji+1
-               IF( dl_lon1(ii,1) < dl_lon0(id_imax0-1,id_jmin0) + dp_delta )THEN
-                  grid__get_fine_offset_cc(1,2)=(id_rho(jp_I)+1)-ji
-                  EXIT
-               ENDIF
-            ENDDO
+            &                 " not match fine grid left corner.")
+         ENDIF
+
+         IF( ll_greenwich )THEN
+            ! close to greenwich meridien
+            ll_greenwich=.FALSE.
+            ! -180:180 => 0:360
+            WHERE( dl_lon0(id_imin0:id_imin0+1,id_jmin0) < 0. )
+               dl_lon0(id_imin0:id_imin0+1,id_jmin0) = &
+                  & dl_lon0(id_imin0:id_imin0+1,id_jmin0)+360.
+            END WHERE
+
+            WHERE( dl_lon1(i1:i2,j1:j2) < 0. )
+               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)+360.
+            END WHERE
+         ENDIF
+
+         !!!!!! look for i-direction right offset !!!!!!
+         i1=MAX(1,il_shape1(jp_I)-(id_rho(jp_I)+2)+1) ; i2=il_shape1(jp_I)
+         j1=1                                         ; j2=1
+
+         ! check if cross greenwich meridien
+         IF( minval(dl_lon0(id_imax0-1:id_imax0,id_jmin0))<5. .OR. &
+           & maxval(dl_lon0(id_imax0-1:id_imax0,id_jmin0))>355. )THEN
+            ! close to greenwich meridien
+            ll_greenwich=.TRUE.
+            ! 0:360 => -180:180
+            WHERE( dl_lon0(id_imax0-1:id_imax0,id_jmin0) > 180. )
+               dl_lon0(id_imax0-1:id_imax0,id_jmin0) = &
+                  & dl_lon0(id_imax0-1:id_imax0,id_jmin0)-360.
+            END WHERE
+
+            WHERE( dl_lon1(i1:i2,j1:j2) > 180. )
+               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)-360.
+            END WHERE
+         ENDIF
+
+         ! min lognitude of the right cell
+         dl_lonmin0=dl_lon0(id_imax0-1,id_jmin0)
+         IF( dl_lon1(il_shape1(jp_I),il_shape1(jp_J)) > dl_lonmin0 )THEN
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('F','U')
+                     dl_dlon= ( dl_lon0(id_imax0  ,id_jmin0) -   &
+                        &       dl_lon0(id_imax0-1,id_jmin0) ) / &
+                        &     ( 2.*id_rho(jp_I) )
+                  CASE DEFAULT
+                     dl_dlon=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlon= ( dl_lon0(id_imax0  ,id_jmin0) -   &
+                  &       dl_lon0(id_imax0-1,id_jmin0) ) / &
+                  &     ( 2.*id_rho(jp_I) )
+            ENDIF
+
+            dl_lon0F= dl_lon0(id_imax0-1,id_jmin0) - dl_dlon
+            dl_lat0F= dd_lat0(id_imax0-1,id_jmin0)
+
+            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), &
+            &                           dl_lon0F, dl_lat0F, 'ri' )
+
+            ii=(MIN(il_shape1(jp_I),(id_rho(jp_I)+2))-il_ind(1)+1)
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('T','V')
+                     grid__get_fine_offset_cc(jp_I,2)=id_rho(jp_I)-ii
+                  CASE DEFAULT !'F','U' 
+                     grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ii
+               END SELECT
+            ELSE
+               ! odd
+               grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ii
+            ENDIF
+
          ELSE
             CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//&
-            &                 " not match fine grid lower right corner.")
-         ENDIF
-
-      ELSE
-         grid__get_fine_offset_cc(1,:)=((id_rho(jp_I)-1)/2)
-      ENDIF
-
-      IF( il_shape1(2) > 1 )THEN
-
-         ! look for j-direction lower offset 
-         IF( dd_lat1(1,1) < dd_lat0(id_imin0,id_jmin0+1) )THEN
-            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
-                  EXIT
-               ENDIF
-            ENDDO
+            &                 " not match fine grid right corner.")
+         ENDIF
+
+         IF( ll_greenwich )THEN
+            ! close to greenwich meridien
+            ll_greenwich=.FALSE.
+            ! -180:180 => 0:360
+            WHERE( dl_lon0(id_imax0-1:id_imax0,id_jmin0) < 0. )
+               dl_lon0(id_imax0-1:id_imax0,id_jmin0) = &
+                  & dl_lon0(id_imax0-1:id_imax0,id_jmin0)+360.
+            END WHERE
+
+            WHERE( dl_lon1(i1:i2,j1:j2) < 0. )
+               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)+360.
+            END WHERE
+         ENDIF
+
+      ELSEIF( il_shape1(jp_I) == 1 )THEN
+         
+         grid__get_fine_offset_cc(jp_I,:)=((id_rho(jp_I)-1)/2)
+         
+         !!! work on j-direction
+         !!! look for j-direction lower offset 
+         i1=1 ; i2=1
+         j1=1 ; j2=MIN((id_rho(jp_J)+2),il_shape1(jp_J))
+
+
+         ! max latitude of the lower cell
+         dl_latmax0=dd_lat0(id_imin0,id_jmin0+1)
+         IF( dd_lat1(1,1) < dl_latmax0 )THEN
+
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('F','V')
+                     dl_dlat= ( dd_lat0(id_imin0,id_jmin0+1) -   &
+                        &       dd_lat0(id_imin0,id_jmin0  ) ) / &
+                        &     ( 2.*id_rho(jp_J) )
+                  CASE DEFAULT
+                     dl_dlat=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlat= ( dd_lat0(id_imin0,id_jmin0+1) -   &
+                  &       dd_lat0(id_imin0,id_jmin0  ) ) / &
+                  &     ( 2.*id_rho(jp_J) )
+            ENDIF
+
+            dl_lon0F= dl_lon0(id_imin0,id_jmin0+1)
+            dl_lat0F= dd_lat0(id_imin0,id_jmin0+1) + dl_dlat 
+            
+            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), &
+            &                           dl_lon0F, dl_lat0F, 'lo' )
+
+            ij=il_ind(2)
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('T','V')
+                     grid__get_fine_offset_cc(jp_I,1)=id_rho(jp_I)-ii
+                  CASE DEFAULT !'F','U' 
+                     grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii
+               END SELECT
+            ELSE
+               ! odd
+               grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii
+            ENDIF
+
          ELSE
             CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//&
-            &                 " not match fine grid upper left corner.")
-         ENDIF
-
-         ! look for j-direction upper offset 
-         IF( dd_lat1(1,il_shape1(2)) > dd_lat0(id_imin0,id_jmax0-1) )THEN
-            DO jj=1,id_rho(jp_J)+2
-               ij=il_shape1(2)-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
-                  EXIT
-               ENDIF
-            ENDDO
+            &                 " not match fine grid lower corner.")
+         ENDIF
+
+         !!! look for j-direction upper offset 
+         i1=1                                         ; i2=1
+         j1=MAX(1,il_shape1(jp_J)-(id_rho(jp_J)+2)+1) ; j2=il_shape1(jp_J)
+
+         ! min latitude of the upper cell
+         dl_latmin0=dd_lat0(id_imin0,id_jmax0-1)
+         IF( dd_lat1(il_shape1(jp_I),il_shape1(jp_J)) > dl_latmin0 )THEN
+
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('F','V')
+                     dl_dlat= ( dd_lat0(id_imin0,id_jmax0  ) -   &
+                        &       dd_lat0(id_imin0,id_jmax0-1) ) / &
+                        &     ( 2.*id_rho(jp_J) )
+                  CASE DEFAULT
+                     dl_dlat=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlat= ( dd_lat0(id_imin0,id_jmax0  ) -   &
+                  &       dd_lat0(id_imin0,id_jmax0-1) ) / &
+                  &     ( 2*id_rho(jp_J) )
+            ENDIF
+
+            dl_lon0F= dl_lon0(id_imin0,id_jmax0-1) 
+            dl_lat0F= dd_lat0(id_imin0,id_jmax0-1) - dl_dlat
+            
+            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), &
+            &                           dl_lon0F, dl_lat0F, 'up' )
+
+            ij=(MIN(il_shape1(jp_J),(id_rho(jp_J)+2))-il_ind(2)+1)
+
+            !!!!! j-direction !!!!!
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('T','U')
+                     grid__get_fine_offset_cc(jp_J,2)=id_rho(jp_J)-ij
+                  CASE DEFAULT !'F','V'
+                     grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-ij
+               END SELECT
+            ELSE
+               ! odd
+               grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-ij
+            ENDIF
+
          ELSE
             CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//&
+            &                 " not match fine grid upper corner.")
+         ENDIF
+
+      ELSE ! il_shape1(1) > 1 .AND. il_shape1(2) > 1 
+
+         !!!!!! look for lower left offset !!!!!!
+         i1=1 ; i2=MIN((id_rho(jp_I)+2),il_shape1(jp_I))
+         j1=1 ; j2=MIN((id_rho(jp_J)+2),il_shape1(jp_J))
+
+         ! check if cross greenwich meridien
+         IF( minval(dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1))<5. .OR. &
+           & maxval(dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1))>355. )THEN
+            ! close to greenwich meridien
+            ll_greenwich=.TRUE.
+            ! 0:360 => -180:180
+            WHERE( dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1) > 180. )
+               dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1) = &
+                  & dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1)-360.
+            END WHERE
+
+            WHERE( dl_lon1(i1:i2,j1:j2) > 180. )
+               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)-360.
+            END WHERE
+         ENDIF
+
+         ! max longitude of the lower left cell
+         dl_lonmax0=MAX(dl_lon0(id_imin0+1,id_jmin0),dl_lon0(id_imin0+1,id_jmin0+1))
+         ! max latitude of the lower left cell
+         dl_latmax0=MAX(dd_lat0(id_imin0,id_jmin0+1),dd_lat0(id_imin0+1,id_jmin0+1))
+         IF( dl_lon1(1,1) < dl_lonmax0 .AND. &
+           & dd_lat1(1,1) < dl_latmax0 )THEN
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('F','U')
+                     dl_dlon= ( dl_lon0(id_imin0+1,id_jmin0+1) -   &
+                        &       dl_lon0(id_imin0  ,id_jmin0+1) ) / &
+                        &     ( 2.*id_rho(jp_I) )
+                  CASE DEFAULT
+                     dl_dlon=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlon= ( dl_lon0(id_imin0+1,id_jmin0+1) -   &
+                  &       dl_lon0(id_imin0  ,id_jmin0+1) ) / &
+                  &     ( 2.*id_rho(jp_I) )
+            ENDIF
+
+            !!!!! j-direction !!!!!
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('F','V')
+                     dl_dlat= ( dd_lat0(id_imin0+1,id_jmin0+1) -   &
+                        &       dd_lat0(id_imin0+1,id_jmin0  ) ) / &
+                        &     ( 2.*id_rho(jp_J) )
+                  CASE DEFAULT
+                     dl_dlat=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlat= ( dd_lat0(id_imin0+1,id_jmin0+1) -   &
+                  &       dd_lat0(id_imin0+1,id_jmin0  ) ) / &
+                  &     ( 2.*id_rho(jp_J) )
+            ENDIF
+
+            dl_lon0F= dl_lon0(id_imin0+1,id_jmin0+1) + dl_dlon
+            dl_lat0F= dd_lat0(id_imin0+1,id_jmin0+1) + dl_dlat
+
+            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), &
+            &                           dl_lon0F, dl_lat0F, 'll' )
+
+            ii=il_ind(1)
+            ij=il_ind(2)
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('T','V')
+                     grid__get_fine_offset_cc(jp_I,1)=id_rho(jp_I)-ii
+                  CASE DEFAULT !'F','U' 
+                     grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii
+               END SELECT
+            ELSE
+               ! odd
+               grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii
+            ENDIF
+
+            !!!!! j-direction !!!!!
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('T','U')
+                     grid__get_fine_offset_cc(jp_J,1)=id_rho(jp_J)-ij
+                  CASE DEFAULT !'F','V'
+                     grid__get_fine_offset_cc(jp_J,1)=(id_rho(jp_J)+1)-ij
+               END SELECT
+            ELSE
+               ! odd
+               grid__get_fine_offset_cc(jp_J,1)=(id_rho(jp_J)+1)-ij
+            ENDIF
+
+         ELSE
+            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do"//&
+            &                 " not match fine grid lower left corner.")
+         ENDIF
+
+         IF( ll_greenwich )THEN
+            ! close to greenwich meridien
+            ll_greenwich=.FALSE.
+            ! -180:180 => 0:360 
+            WHERE( dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1) < 0. )
+               dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1) = &
+                  & dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1)+360.
+            END WHERE
+
+            WHERE( dl_lon1(i1:i2,j1:j2) < 0. )
+               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)+360.
+            END WHERE
+         ENDIF
+
+         !!!!!! look for upper right offset !!!!!!
+         i1=MAX(1,il_shape1(jp_I)-(id_rho(jp_I)+2)+1) ; i2=il_shape1(jp_I)
+         j1=MAX(1,il_shape1(jp_J)-(id_rho(jp_J)+2)+1) ; j2=il_shape1(jp_J)
+
+         ! check if cross greenwich meridien
+         IF( minval(dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0))<5. .OR. &
+           & maxval(dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0))>355. )THEN
+            ! close to greenwich meridien
+            ll_greenwich=.TRUE.
+            ! 0:360 => -180:180
+            WHERE( dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0) > 180. )
+               dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0) = &
+                  & dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0)-360.
+            END WHERE
+
+            WHERE( dl_lon1(i1:i2,j1:j2) > 180. )
+               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)-360.
+            END WHERE
+         ENDIF
+
+         ! min latitude of the upper right cell
+         dl_lonmin0=MIN(dl_lon0(id_imax0-1,id_jmax0-1),dl_lon0(id_imax0-1,id_jmax0))
+         ! min latitude of the upper right cell
+         dl_latmin0=MIN(dd_lat0(id_imax0-1,id_jmax0-1),dd_lat0(id_imax0,id_jmax0-1))
+         IF( dl_lon1(il_shape1(jp_I),il_shape1(jp_J)) > dl_lonmin0 .AND. &
+           & dd_lat1(il_shape1(jp_I),il_shape1(jp_J)) > dl_latmin0 )THEN
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('F','U')
+                     dl_dlon= ( dl_lon0(id_imax0  ,id_jmax0-1) -   &
+                        &       dl_lon0(id_imax0-1,id_jmax0-1) ) / &
+                        &     ( 2.*id_rho(jp_I) )
+                  CASE DEFAULT
+                     dl_dlon=0
+               END SELECT               
+            ELSE
+               ! odd
+               dl_dlon= ( dl_lon0(id_imax0  ,id_jmax0-1) -   &
+                  &       dl_lon0(id_imax0-1,id_jmax0-1) ) / &
+                  &     ( 2*id_rho(jp_I) )
+            ENDIF
+
+            !!!!! j-direction !!!!!
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('F','V')
+                     dl_dlat= ( dd_lat0(id_imax0-1,id_jmax0  ) -   &
+                        &       dd_lat0(id_imax0-1,id_jmax0-1) ) / &
+                        &     ( 2.*id_rho(jp_J) )
+                  CASE DEFAULT
+                     dl_dlat=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlat= ( dd_lat0(id_imax0-1,id_jmax0  ) -   &
+                  &       dd_lat0(id_imax0-1,id_jmax0-1) ) / &
+                  &     ( 2*id_rho(jp_J) )
+            ENDIF
+
+            dl_lon0F= dl_lon0(id_imax0-1,id_jmax0-1) - dl_dlon
+            dl_lat0F= dd_lat0(id_imax0-1,id_jmax0-1) - dl_dlat
+
+            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), &
+            &                           dl_lon0F, dl_lat0F, 'ur' )
+
+            ii=(MIN(il_shape1(jp_I),(id_rho(jp_I)+2))-il_ind(1)+1)
+            ij=(MIN(il_shape1(jp_J),(id_rho(jp_J)+2))-il_ind(2)+1)
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('T','V')
+                     grid__get_fine_offset_cc(jp_I,2)=id_rho(jp_I)-ii
+                  CASE DEFAULT !'F','U' 
+                     grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ii
+               END SELECT
+            ELSE
+               ! odd
+               grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ii
+            ENDIF
+
+            !!!!! j-direction !!!!!
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('T','U')
+                     grid__get_fine_offset_cc(jp_J,2)=id_rho(jp_J)-ij
+                  CASE DEFAULT !'F','V'
+                     grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-ij
+               END SELECT
+            ELSE
+               ! odd
+               grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-ij
+            ENDIF
+
+         ELSE
+            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do"//&
             &                 " not match fine grid upper right corner.")
          ENDIF
-      ELSE
-         grid__get_fine_offset_cc(2,:)=((id_rho(jp_J)-1)/2)
+
+         IF( ll_greenwich )THEN
+            ! close to greenwich meridien
+            ll_greenwich=.FALSE.
+            ! -180:180 => 0:360
+            WHERE( dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0) < 0. )
+               dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0) = &
+                  & dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0)+360.
+            END WHERE
+
+            WHERE( dl_lon1(i1:i2,j1:j2) < 0. )
+               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)+360.
+            END WHERE
+         ENDIF
+
       ENDIF
 
       DEALLOCATE( dl_lon0 )
       DEALLOCATE( dl_lon1 )
+
+      IF( ANY(grid__get_fine_offset_cc(:,:)==-1) )THEN
+         CALL logger_fatal("GRID GET FINE OFFSET: can not found "//&
+         &                 " offset between coarse and fine grid.")
+      ENDIF
 
    END FUNCTION grid__get_fine_offset_cc
@@ -3732,8 +4526,11 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013- Initial Version
    !> @date October, 2014
    !> - work on mpp file structure instead of file structure
-   !
+   !> @date February, 2016
+   !> - use F-point to check coincidence for even refinment
+   !> - use F-point estimation, if can not read it.
+   !>
    !> @param[in] td_coord0 coarse grid coordinate file structure 
    !> @param[in] td_coord1 fine   grid coordinate file structure 
@@ -3742,5 +4539,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, &
@@ -3760,39 +4557,54 @@
 
       ! local variable
-      INTEGER(i4) :: il_imid1
-      INTEGER(i4) :: il_jmid1
+      INTEGER(i4)               :: il_imid1
+      INTEGER(i4)               :: il_jmid1
       
-      INTEGER(i4) :: il_ew0
-      INTEGER(i4) :: il_ew1
-
-      INTEGER(i4) :: il_imin1
-      INTEGER(i4) :: il_imax1
-      INTEGER(i4) :: il_jmin1
-      INTEGER(i4) :: il_jmax1
-
-      INTEGER(i4), DIMENSION(2) :: il_indC
-      INTEGER(i4), DIMENSION(2) :: il_indF
-      INTEGER(i4), DIMENSION(2) :: il_iind
-      INTEGER(i4), DIMENSION(2) :: il_jind
-
-      REAL(dp)    :: dl_lon0
-      REAL(dp)    :: dl_lat0
-      REAL(dp)    :: dl_lon1
-      REAL(dp)    :: dl_lat1
-
-      REAL(dp)    :: dl_lon1p
-      REAL(dp)    :: dl_lat1p
-
-      LOGICAL     :: ll_coincidence
-
-      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(TDOM)  :: tl_dom0
+      INTEGER(i4)               :: il_ew0
+      INTEGER(i4)               :: il_ew1
+
+      INTEGER(i4)               :: il_ind
+
+      INTEGER(i4)               :: il_imin1
+      INTEGER(i4)               :: il_imax1
+      INTEGER(i4)               :: il_jmin1
+      INTEGER(i4)               :: il_jmax1
+
+      INTEGER(i4), DIMENSION(2) :: il_ind0
+      INTEGER(i4), DIMENSION(2) :: il_ind1
+
+      INTEGER(i4), DIMENSION(2) :: il_ill1
+      INTEGER(i4), DIMENSION(2) :: il_ilr1
+      INTEGER(i4), DIMENSION(2) :: il_iul1
+      INTEGER(i4), DIMENSION(2) :: il_iur1
+
+      REAL(dp)                  :: dl_lon0F
+      REAL(dp)                  :: dl_lat0F
+      REAL(dp)                  :: dl_lon0
+      REAL(dp)                  :: dl_lat0
+      REAL(dp)                  :: dl_lon1F
+      REAL(dp)                  :: dl_lat1F
+      REAL(dp)                  :: dl_lon1
+      REAL(dp)                  :: dl_lat1
+
+      REAL(dp)                  :: dl_delta
+
+      LOGICAL                   :: ll_coincidence
+      LOGICAL                   :: ll_even
+      LOGICAL                   :: ll_grid0F
+      LOGICAL                   :: ll_grid1F
+
+      TYPE(TVAR)                :: tl_lon0
+      TYPE(TVAR)                :: tl_lat0
+      TYPE(TVAR)                :: tl_lon0F
+      TYPE(TVAR)                :: tl_lat0F
+      TYPE(TVAR)                :: tl_lon1
+      TYPE(TVAR)                :: tl_lat1
+      TYPE(TVAR)                :: tl_lon1F
+      TYPE(TVAR)                :: tl_lat1F
+
+      TYPE(TMPP)                :: tl_coord0
+      TYPE(TMPP)                :: tl_coord1
+
+      TYPE(TDOM)                :: tl_dom0
 
       ! loop indices
@@ -3803,4 +4615,9 @@
       ll_coincidence=.TRUE.
 
+      ll_even=.FALSE.
+      IF( MOD(id_rho(jp_I)*id_rho(jp_J),2) == 0 )THEN
+         ll_even=.TRUE.
+      ENDIF
+
       ! copy structure
       tl_coord0=mpp_copy(td_coord0)
@@ -3815,6 +4632,37 @@
 
       ! read variable value on domain
-      tl_lon0=iom_dom_read_var(tl_coord0,'longitude',tl_dom0)
-      tl_lat0=iom_dom_read_var(tl_coord0,'latitude' ,tl_dom0)
+      il_ind=var_get_index(tl_coord0%t_proc(1)%t_var(:), 'longitude_T')
+      IF( il_ind /= 0 )THEN
+         tl_lon0=iom_dom_read_var(tl_coord0,'longitude_T',tl_dom0)
+      ELSE
+         tl_lon0=iom_dom_read_var(tl_coord0,'longitude',tl_dom0)
+      ENDIF
+
+      il_ind=var_get_index(tl_coord0%t_proc(1)%t_var(:), 'latitude_T')
+      IF( il_ind /= 0 )THEN
+         tl_lat0=iom_dom_read_var(tl_coord0,'latitude_T' ,tl_dom0)
+      ELSE
+         tl_lat0=iom_dom_read_var(tl_coord0,'latitude' ,tl_dom0)
+      ENDIF
+
+      IF( ll_even )THEN
+         ! look for variable value on domain for F point
+         il_ind=var_get_index(tl_coord0%t_proc(1)%t_var(:), 'longitude_F')
+         IF( il_ind /= 0 )THEN
+            tl_lon0F=iom_dom_read_var(tl_coord0,'longitude_F',tl_dom0)
+         ENDIF
+
+         il_ind=var_get_index(tl_coord0%t_proc(1)%t_var(:), 'latitude_F')
+         IF( il_ind /= 0 )THEN
+            tl_lat0F=iom_dom_read_var(tl_coord0,'latitude_F' ,tl_dom0)
+         ENDIF
+
+         ll_grid0F=.FALSE.
+         IF( ASSOCIATED(tl_lon0F%d_value) .AND. &
+         &   ASSOCIATED(tl_lat0F%d_value) )THEN
+            ll_grid0F=.TRUE.
+         ENDIF
+
+      ENDIF
 
       ! close mpp files
@@ -3832,9 +4680,40 @@
 
       ! read fine longitue and latitude
-      tl_lon1=iom_mpp_read_var(tl_coord1,'longitude')
-      tl_lat1=iom_mpp_read_var(tl_coord1,'latitude')
+      il_ind=var_get_index(tl_coord1%t_proc(1)%t_var(:), TRIM(tl_lon0%c_longname))
+      IF( il_ind /= 0 )THEN
+         tl_lon1=iom_mpp_read_var(tl_coord1,TRIM(tl_lon0%c_longname))
+      ELSE
+         tl_lon1=iom_mpp_read_var(tl_coord1,'longitude')
+      ENDIF
+      il_ind=var_get_index(tl_coord1%t_proc(1)%t_var(:), TRIM(tl_lat0%c_longname))
+      IF( il_ind /= 0 )THEN
+         tl_lat1=iom_mpp_read_var(tl_coord1,TRIM(tl_lat0%c_longname))
+      ELSE
+         tl_lat1=iom_mpp_read_var(tl_coord1,'latitude')
+      ENDIF
       
+      IF( ll_even )THEN
+
+         ! look for variable value on domain for F point
+         il_ind=var_get_index(tl_coord1%t_proc(1)%t_var(:), 'longitude_F')
+         IF( il_ind /= 0 )THEN
+            tl_lon1F=iom_mpp_read_var(tl_coord1,'longitude_F')
+         ENDIF
+
+         il_ind=var_get_index(tl_coord1%t_proc(1)%t_var(:), 'latitude_F')
+         IF( il_ind /= 0 )THEN
+            tl_lat1F=iom_mpp_read_var(tl_coord1,'latitude_F')
+         ENDIF
+
+         ll_grid1F=.FALSE.
+         IF( ASSOCIATED(tl_lon1F%d_value) .AND. &
+         &   ASSOCIATED(tl_lat1F%d_value) )THEN
+            ll_grid1F=.TRUE.
+         ENDIF
+
+      ENDIF
+
       ! close mpp files
-      CALL iom_dom_close(tl_coord1)
+      CALL iom_mpp_close(tl_coord1)
       ! clean structure
       CALL mpp_clean(tl_coord1)
@@ -3898,5 +4777,5 @@
          IF( .NOT. ll_coincidence )THEN
             CALL logger_fatal("GRID CHECK COINCIDENCE: no coincidence "//&
-            &              "between fine grid and coarse grid. invalid domain" )
+            &              "between fine grid and coarse grid: invalid domain." )
          ENDIF
 
@@ -3912,61 +4791,36 @@
 
       ! select closest point on coarse grid
-      il_indC(:)=grid_get_closest(tl_lon0%d_value(:,:,1,1),&
+      il_ind0(:)=grid_get_closest(tl_lon0%d_value(:,:,1,1),&
       &                           tl_lat0%d_value(:,:,1,1),&
       &                           dl_lon1, dl_lat1   )
 
-      IF( ANY(il_indC(:)==0) )THEN
+      IF( ANY(il_ind0(:)==0) )THEN
          CALL logger_fatal("GRID CHECK COINCIDENCE: can not find valid "//&
-         &              "coarse grid indices. invalid domain" )
-      ENDIF
-
-      dl_lon0=tl_lon0%d_value(il_indC(1),il_indC(2),1,1)
-      dl_lat0=tl_lat0%d_value(il_indC(1),il_indC(2),1,1)
-
-      ! look for closest fine grid point from selected coarse grid point
-      il_iind(:)=MAXLOC( tl_lon1%d_value(:,:,1,1), &
-      &                  tl_lon1%d_value(:,:,1,1) <= dl_lon0 )
-
-      il_jind(:)=MAXLOC( tl_lat1%d_value(:,:,1,1), &
-      &                  tl_lat1%d_value(:,:,1,1) <= dl_lat0 )
-
-      il_indF(1)=il_iind(1)
-      il_indF(2)=il_jind(2)
-
-      IF( ANY(il_indF(:)==0) )THEN
-         CALL logger_fatal("GRID CHECK COINCIDENCE: can not find valid "//&
-         &              "fine grid indices. invalid domain" )
-      ENDIF
-
-      dl_lon1=tl_lon1%d_value(il_indF(1),il_indF(2),1,1)
-      dl_lat1=tl_lat1%d_value(il_indF(1),il_indF(2),1,1)
-
-      ! check i-direction refinement factor
-      DO ji=1,MIN(3,il_imid1)
-
-         IF( il_indF(1)+ji*id_rho(jp_I)+1 > tl_lon1%t_dim(1)%i_len )THEN
-            CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//&
-            &  " to check i-direction refinement factor ")
-            EXIT
-         ELSE
-            dl_lon1=tl_lon1%d_value(il_indF(1)+ji*id_rho(jp_I),il_indF(2),1,1)
-            dl_lon0=tl_lon0%d_value(il_indC(1)+ji,il_indC(2),1,1)
-
-            dl_lon1p=tl_lon1%d_value(il_indF(1)+ji*id_rho(jp_I)+1,il_indF(2),1,1)
-
-            SELECT CASE(MOD(id_rho(jp_I),2))
-
-            CASE(0)
-
-               IF( dl_lon1 >= dl_lon0 .OR. dl_lon0 >= dl_lon1p )THEN
-                  ll_coincidence=.FALSE.
-                  CALL logger_debug("GRID CHECK COINCIDENCE: invalid "//&
-                  &  "i-direction refinement factor ("//&
-                  &   TRIM(fct_str(id_rho(jp_I)))//&
-                  &   ") between fine grid and coarse grid ")
-               ENDIF
-
-            CASE DEFAULT         
-            
+         &              "coarse grid indices: invalid domain." )
+      ENDIF
+
+      IF( .NOT. ll_even )THEN
+         ! case odd refinment in both direction
+         ! work on T-point
+
+         dl_lon0=tl_lon0%d_value(il_ind0(1),il_ind0(2),1,1)
+         dl_lat0=tl_lat0%d_value(il_ind0(1),il_ind0(2),1,1)
+
+         il_ind1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),&
+         &                           tl_lat1%d_value(:,:,1,1),&
+         &                           dl_lon0, dl_lat0 )
+
+         ! check i-direction refinement factor
+         DO ji=0,MIN(3,il_imid1)
+
+            IF( il_ind1(1)+ji*id_rho(jp_I)+1 > tl_lon1%t_dim(1)%i_len )THEN
+               CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//&
+               &  " to check i-direction refinement factor ")
+               EXIT
+            ELSE
+               dl_lon0=tl_lon0%d_value(il_ind0(1)+ji             ,il_ind0(2),1,1)
+               dl_lon1=tl_lon1%d_value(il_ind1(1)+ji*id_rho(jp_I),il_ind1(2),1,1)
+
+               ! assume there could be little difference due to interpolation
                IF( ABS(dl_lon1 - dl_lon0) > dp_delta )THEN
                   ll_coincidence=.FALSE.
@@ -3976,37 +4830,20 @@
                   &  ") between fine grid and coarse grid ")
                ENDIF
-            
-            END SELECT
-         ENDIF
-
-      ENDDO
-
-      ! check j-direction refinement factor
-      DO jj=1,MIN(3,il_jmid1)
-
-         IF( il_indF(2)+jj*id_rho(jp_J)+1 > tl_lat1%t_dim(2)%i_len )THEN
-            CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//&
-            &  " to check j-direction refinement factor ")
-            EXIT
-         ELSE      
-            dl_lat1=tl_lat1%d_value(il_indF(1),il_indF(2)+jj*id_rho(jp_J),1,1)
-            dl_lat0=tl_lat0%d_value(il_indC(1),il_indC(2)+jj,1,1)
-
-            dl_lat1p=tl_lat1%d_value(il_indF(1),il_indF(2)+jj*id_rho(jp_J)+1,1,1)
-
-            SELECT CASE(MOD(id_rho(jp_J),2))
-
-            CASE(0)
-               
-               IF( dl_lat1 >= dl_lat0 .OR. dl_lat0 >= dl_lat1p )THEN
-                  ll_coincidence=.FALSE.
-                  CALL logger_debug("GRID CHECK COINCIDENCE: invalid "//&
-                  &  "j-direction refinement factor ("//&
-                  &   TRIM(fct_str(id_rho(jp_J)))//&
-                  &  ") between fine grid and coarse grid ")
-               ENDIF
-
-            CASE DEFAULT
-
+            ENDIF
+
+         ENDDO
+
+         ! check j-direction refinement factor
+         DO jj=0,MIN(3,il_jmid1)
+
+            IF( il_ind1(2)+jj*id_rho(jp_J)+1 > tl_lat1%t_dim(2)%i_len )THEN
+               CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//&
+               &  " to check j-direction refinement factor ")
+               EXIT
+            ELSE      
+               dl_lat0=tl_lat0%d_value(il_ind0(1),il_ind0(2)+jj             ,1,1)
+               dl_lat1=tl_lat1%d_value(il_ind1(1),il_ind1(2)+jj*id_rho(jp_J),1,1)
+
+               ! assume there could be little difference due to interpolation
                IF( ABS(dl_lat1-dl_lat0) > dp_delta )THEN
                   ll_coincidence=.FALSE.
@@ -4016,9 +4853,159 @@
                   &  ") between fine grid and coarse grid ")
                ENDIF
-
-            END SELECT
-         ENDIF
-
-      ENDDO
+            ENDIF
+
+         ENDDO
+
+      ELSE
+         ! case even refinment at least in one direction
+         ! work on F-point
+
+         dl_delta=dp_delta
+         ! look for lower left fine point in coarse cell.
+         IF( ll_grid0F )THEN
+      
+            ! lower left corner of coarse cell
+            dl_lon0F=tl_lon0F%d_value(il_ind0(1)-1,il_ind0(2)-1,1,1)
+            dl_lat0F=tl_lat0F%d_value(il_ind0(1)-1,il_ind0(2)-1,1,1)
+
+         ELSE
+
+            ! approximate lower left corner of coarse cell (with T point)
+            dl_lon0F=( tl_lon0%d_value(il_ind0(1)  ,il_ind0(2)  ,1,1) + &
+            &          tl_lon0%d_value(il_ind0(1)  ,il_ind0(2)-1,1,1) + &
+            &          tl_lon0%d_value(il_ind0(1)-1,il_ind0(2)  ,1,1) + &
+            &          tl_lon0%d_value(il_ind0(1)-1,il_ind0(2)-1,1,1) ) * 0.25
+
+            dl_lat0F=( tl_lat0%d_value(il_ind0(1)  ,il_ind0(2)  ,1,1) + &
+            &          tl_lat0%d_value(il_ind0(1)  ,il_ind0(2)-1,1,1) + &
+            &          tl_lat0%d_value(il_ind0(1)-1,il_ind0(2)  ,1,1) + &
+            &          tl_lat0%d_value(il_ind0(1)-1,il_ind0(2)-1,1,1) ) * 0.25
+
+            ! as we use approximation of F-point we relax condition
+            dl_delta=100*dp_delta
+
+         ENDIF
+
+         IF( ll_grid1F )THEN
+      
+            il_ind1(:)=grid_get_closest(tl_lon1F%d_value(:,:,1,1),&
+            &                           tl_lat1F%d_value(:,:,1,1),&
+            &                           dl_lon0F, dl_lat0F )
+
+         ELSE
+
+            il_ill1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),&
+            &                           tl_lat1%d_value(:,:,1,1),&
+            &                           dl_lon0F, dl_lat0F, 'll' )
+
+            il_ilr1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),&
+            &                           tl_lat1%d_value(:,:,1,1),&
+            &                           dl_lon0F, dl_lat0F, 'lr' )
+
+            il_iul1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),&
+            &                           tl_lat1%d_value(:,:,1,1),&
+            &                           dl_lon0F, dl_lat0F, 'ul' )
+
+            il_iur1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),&
+            &                           tl_lat1%d_value(:,:,1,1),&
+            &                           dl_lon0F, dl_lat0F, 'ur' )
+
+            ! as we use approximation of F-point we relax condition
+            dl_delta=100*dp_delta
+
+         ENDIF
+
+         ! check i-direction refinement factor
+         DO ji=0,MIN(3,il_imid1)
+
+            IF( il_ind1(1)+ji*id_rho(jp_I)+1 > tl_lon1%t_dim(1)%i_len )THEN
+               CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//&
+               &  " to check i-direction refinement factor ")
+               EXIT
+            ELSE
+               IF( ll_grid0F )THEN
+                  dl_lon0F=tl_lon0F%d_value(il_ind0(1)+ji-1, il_ind0(2)-1,1,1)
+               ELSE
+                  dl_lon0F= 0.25 * &
+                  & ( tl_lon0%d_value(il_ind0(1)+ji  , il_ind0(2)  ,1,1) + &
+                  &   tl_lon0%d_value(il_ind0(1)+ji-1, il_ind0(2)  ,1,1) + &
+                  &   tl_lon0%d_value(il_ind0(1)+ji  , il_ind0(2)-1,1,1) + &
+                  &   tl_lon0%d_value(il_ind0(1)+ji-1, il_ind0(2)-1,1,1) )
+               ENDIF
+
+               IF( ll_grid1F )THEN
+                  dl_lon1F= tl_lon1F%d_value( il_ind1(1)+ji*id_rho(jp_I), &
+                                            & il_ind1(2),1,1)
+               ELSE
+                  dl_lon1F= 0.25 * &
+                  & ( tl_lon1%d_value( il_ill1(1)+ji*id_rho(jp_I), &
+                                     & il_ill1(2),1,1) + &
+                  &   tl_lon1%d_value( il_ilr1(1)+ji*id_rho(jp_I), &
+                                     & il_ilr1(2),1,1) + &
+                  &   tl_lon1%d_value( il_iul1(1)+ji*id_rho(jp_I), &
+                                     & il_iul1(2),1,1) + &
+                  &   tl_lon1%d_value( il_iur1(1)+ji*id_rho(jp_I), &
+                                     & il_iur1(2),1,1) )
+                  
+               ENDIF
+
+               ! assume there could be little difference due to interpolation
+               IF( ABS(dl_lon1F - dl_lon0F) > dl_delta )THEN
+                  ll_coincidence=.FALSE.
+                  CALL logger_debug("GRID CHECK COINCIDENCE: invalid "//&
+                  &  "i-direction refinement factor ("//&
+                  &   TRIM(fct_str(id_rho(jp_I)))//&
+                  &  ") between fine grid and coarse grid ")
+               ENDIF
+            ENDIF
+
+         ENDDO
+
+         ! check j-direction refinement factor
+         DO jj=0,MIN(3,il_jmid1)
+
+            IF( il_ind1(2)+jj*id_rho(jp_J)+1 > tl_lat1%t_dim(2)%i_len )THEN
+               CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//&
+               &  " to check j-direction refinement factor ")
+               EXIT
+            ELSE      
+               IF( ll_grid0F )THEN
+                  dl_lat0F=tl_lat0F%d_value(il_ind0(1)-1, il_ind0(2)+jj-1,1,1)
+               ELSE
+                  dl_lat0F= 0.25 * &
+                  & ( tl_lat0%d_value(il_ind0(1)  , il_ind0(2)+jj  ,1,1) + &
+                  &   tl_lat0%d_value(il_ind0(1)-1, il_ind0(2)+jj  ,1,1) + &
+                  &   tl_lat0%d_value(il_ind0(1)  , il_ind0(2)+jj-1,1,1) + &
+                  &   tl_lat0%d_value(il_ind0(1)-1, il_ind0(2)+jj-1,1,1) )
+               ENDIF
+
+               IF( ll_grid1F )THEN
+                  dl_lat1F= tl_lat1F%d_value( il_ind1(1), &
+                                            & il_ind1(2)+jj*id_rho(jp_J),1,1)
+               ELSE
+                  dl_lat1F= 0.25 * &
+                  & ( tl_lat1%d_value( il_ill1(1), &
+                                     & il_ill1(2)+jj*id_rho(jp_J),1,1) + &
+                  &   tl_lat1%d_value( il_ilr1(1), &
+                                     & il_ilr1(2)+jj*id_rho(jp_J),1,1) + &
+                  &   tl_lat1%d_value( il_iul1(1), &
+                                     & il_iul1(2)+jj*id_rho(jp_J),1,1) + &
+                  &   tl_lat1%d_value( il_iur1(1), &
+                                     & il_iur1(2)+jj*id_rho(jp_J),1,1) )
+                  
+               ENDIF
+
+               ! assume there could be little difference due to interpolation
+               IF( ABS(dl_lat1F - dl_lat0F) > dl_delta )THEN
+                  ll_coincidence=.FALSE.
+                  CALL logger_debug("GRID CHECK COINCIDENCE: invalid "//&
+                  &  "i-direction refinement factor ("//&
+                  &   TRIM(fct_str(id_rho(jp_I)))//&
+                  &  ") between fine grid and coarse grid ")
+               ENDIF
+            ENDIF
+
+         ENDDO
+      ENDIF
 
       ! clean 
@@ -4042,5 +5029,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] dd_lon0   array of coarse grid longitude
@@ -4103,5 +5090,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 +5188,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] dd_lat0   array of coarse grid latitude 
@@ -4272,5 +5258,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013-Initial version
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_var array of variable structure 
@@ -4348,5 +5334,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013-Initial version
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_var array of variable structure 
@@ -4374,6 +5360,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 +5413,5 @@
    !>
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !
    !> @param[in] td_var variable sturcture 
@@ -4555,5 +5543,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
@@ -4590,10 +5578,11 @@
 
          ! copy structure
-          tl_mpp=mpp_copy(td_mpp)
-
-          IF( tl_mpp%i_perio < 0 )THEN
-             ! compute NEMO periodicity index
-             CALL grid_get_info(tl_mpp)
-          ENDIF
+         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
+            CALL grid_get_info(tl_mpp)
+         ENDIF
 
          SELECT CASE(tl_mpp%i_perio)
@@ -4627,5 +5616,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_var    variable strucutre 
@@ -4694,4 +5683,5 @@
                         il_tmp(jim:jip,jjm:jjp)=1
                      END WHERE
+
                   ENDIF
                ENDDO
@@ -4720,10 +5710,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 +5772,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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/interp.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/interp.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/interp.f90	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/interp_cubic.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/interp_cubic.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/interp_cubic.f90	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/interp_linear.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/interp_linear.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/interp_linear.f90	(revision 6440)
@@ -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
@@ -618,13 +627,13 @@
       
       IF( ld_even(jp_I) )THEN
-         dl_dx=1./REAL(id_rho(jp_I)-1)
+         dl_dx=1._dp/REAL(id_rho(jp_I)-1,dp)
       ELSE ! odd refinement
-         dl_dx=1./REAL(id_rho(jp_I))
+         dl_dx=1._dp/REAL(id_rho(jp_I),dp)
       ENDIF
 
       IF( ld_even(jp_J) )THEN
-         dl_dy=1./REAL(id_rho(jp_J)-1)
+         dl_dy=1._dp/REAL(id_rho(jp_J)-1,dp)
       ELSE ! odd refinement
-         dl_dy=1./REAL(id_rho(jp_J))
+         dl_dy=1._dp/REAL(id_rho(jp_J),dp)
       ENDIF
 
@@ -633,7 +642,7 @@
 
          IF( ld_even(jp_J) )THEN
-            dl_y=(jj-1)*dl_dy - dl_dy*0.5 
+            dl_y=REAL(jj-1,dp)*dl_dy - dl_dy*0.5_dp
          ELSE ! odd refinement
-            dl_y=(jj-1)*dl_dy 
+            dl_y=REAL(jj-1,dp)*dl_dy 
          ENDIF
 
@@ -644,7 +653,7 @@
 
             IF( ld_even(jp_I) )THEN
-               dl_x=(ji-1)*dl_dx - dl_dx*0.5 
+               dl_x=REAL(ji-1,dp)*dl_dx - dl_dx*0.5_dp 
             ELSE ! odd refinement
-               dl_x=(ji-1)*dl_dx 
+               dl_x=REAL(ji-1,dp)*dl_dx 
             ENDIF
 
@@ -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
@@ -683,14 +692,14 @@
       
       IF( ld_even )THEN
-         dl_dx=1./REAL(id_rho-1)
+         dl_dx=1._dp/REAL(id_rho-1,dp)
       ELSE ! odd refinement
-         dl_dx=1./REAL(id_rho)
+         dl_dx=1._dp/REAL(id_rho,dp)
       ENDIF
 
       DO ji=1,id_rho+1
          IF( ld_even )THEN
-            dl_x=(ji-1)*dl_dx - dl_dx*0.5 
+            dl_x=REAL(ji-1,dp)*dl_dx - dl_dx*0.5_dp 
          ELSE ! odd refinement
-            dl_x=(ji-1)*dl_dx 
+            dl_x=REAL(ji-1,dp)*dl_dx 
          ENDIF
 
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/interp_nearest.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/interp_nearest.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/interp_nearest.f90	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/iom.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/iom.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/iom.f90	(revision 6440)
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/iom_cdf.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/iom_cdf.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/iom_cdf.f90	(revision 6440)
@@ -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,8 @@
             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)
+            CALL iom_cdf__check(il_status," IOM CDF CREATE: ")
 
             td_file%l_def=.TRUE.
@@ -213,4 +221,5 @@
 
       ELSE
+
          IF( td_file%i_id /= 0 )THEN
 
@@ -228,7 +237,6 @@
                &                      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: ")
+
             ELSE
 
@@ -239,5 +247,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 +275,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -291,5 +299,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 +315,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -326,5 +334,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 +353,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -353,7 +361,10 @@
       ! Argument      
       TYPE(TFILE), INTENT(INOUT) :: td_file
+      ! local variable
+      TYPE(TDIM) :: tl_dim
 
       ! loop indices
       INTEGER(i4) :: ji
+      INTEGER(i4) :: ii
       !----------------------------------------------------------------
 
@@ -364,7 +375,17 @@
 
       IF( td_file%i_ndim > 0 )THEN
+         ii=1
          DO ji = 1, td_file%i_ndim
             ! read dimension information
-            td_file%t_dim(ji)=iom_cdf_read_dim( td_file, ji)
+            tl_dim=iom_cdf_read_dim( td_file, ji)
+            IF( .NOT. dim_is_dummy(tl_dim) )THEN
+               IF( ii > ip_maxdim )THEN
+                  CALL logger_fatal("IOM CDF OPEN: too much dimension "//&
+                  & "to be read. you should remove dummy dimension using "//&
+                  & " configuration file")
+               ENDIF
+               td_file%t_dim(ii)=dim_copy(tl_dim)
+               ii=ii+1
+            ENDIF
          ENDDO
 
@@ -396,5 +417,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.
@@ -408,6 +429,9 @@
 
       ! local variable
+      TYPE(TATT) :: tl_att
+
       ! loop indices
       INTEGER(i4) :: ji
+      INTEGER(i4) :: ii
       !----------------------------------------------------------------
 
@@ -419,7 +443,12 @@
          ALLOCATE(td_file%t_att(td_file%i_natt))
 
+         ii=1
          DO ji = 1, td_file%i_natt
             ! read global attribute
-            td_file%t_att(ji)=iom_cdf_read_att( td_file, NF90_GLOBAL, ji)
+            tl_att=iom_cdf_read_att( td_file, NF90_GLOBAL, ji)
+            IF( .NOT. att_is_dummy(tl_att) )THEN
+               td_file%t_att(ii)=att_copy(tl_att)
+               ii=ii+1
+            ENDIF
             
          ENDDO
@@ -439,5 +468,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2015
+   !> - manage useless (dummy) variable
+   !> @date January, 2016
+   !> - increment n3d for 4D variable
    !
    !> @param[inout] td_file   file structure
@@ -450,67 +483,92 @@
       ! local variable
       INTEGER(i4) :: il_attid
+      INTEGER(i4) :: il_nvar
+
+      TYPE(TVAR), DIMENSION(:), ALLOCATABLE  :: tl_var
 
       ! loop indices
       INTEGER(i4) :: ji
+      INTEGER(i4) :: ii
       !----------------------------------------------------------------
 
       IF( td_file%i_nvar > 0 )THEN
+
          IF(ASSOCIATED(td_file%t_var))THEN
             CALL var_clean(td_file%t_var(:))
             DEALLOCATE(td_file%t_var)
          ENDIF
+
+         il_nvar=td_file%i_nvar
+         ALLOCATE(tl_var(il_nvar))
+         ii=0
+         DO ji = 1, il_nvar
+           ! read variable information
+           tl_var(ji)=iom_cdf__read_var_meta( td_file, ji) 
+           IF( .NOT. var_is_dummy(tl_var(ji)) )THEN
+              ii=ii+1
+           ENDIF
+         ENDDO
+
+         ! update number of variable used
+         td_file%i_nvar=ii
+
          ALLOCATE(td_file%t_var(td_file%i_nvar))
 
-         DO ji = 1, td_file%i_nvar
-            ! read dimension information
-            td_file%t_var(ji)=iom_cdf__read_var_meta( td_file, ji)
-            SELECT CASE(td_file%t_var(ji)%i_ndim)
-               CASE(0)
-                  td_file%i_n0d=td_file%i_n0d+1
-               CASE(1)
-                  td_file%i_n1d=td_file%i_n1d+1
-                  td_file%i_rhd=td_file%i_rhd+1
-               CASE(2)
-                  td_file%i_n2d=td_file%i_n2d+1
-                  td_file%i_rhd=td_file%i_rhd+1
-               CASE(3)
-                  td_file%i_n3d=td_file%i_n3d+1
-                  td_file%i_rhd=td_file%i_rhd+td_file%t_dim(3)%i_len
-            END SELECT
-
-            ! look for depth id
-            IF( INDEX(TRIM(td_file%t_var(ji)%c_name),'depth') /= 0 )THEN
-               IF( td_file%i_depthid == 0 )THEN
-                  td_file%i_depthid=ji
-               ELSE
-                  IF( td_file%i_depthid /= ji )THEN
-                     CALL logger_error("IOM CDF GET FILE VAR: find more than one "//&
-                     &                 "depth variable in file "//&
-                     &                 TRIM(td_file%c_name) )
+         ii=0
+         DO ji = 1, il_nvar
+            IF( .NOT. var_is_dummy(tl_var(ji)) )THEN
+               ii=ii+1
+               td_file%t_var(ii)=var_copy(tl_var(ji))
+               SELECT CASE(td_file%t_var(ii)%i_ndim)
+                  CASE(0)
+                     td_file%i_n0d=td_file%i_n0d+1
+                  CASE(1)
+                     td_file%i_n1d=td_file%i_n1d+1
+                     td_file%i_rhd=td_file%i_rhd+1
+                  CASE(2)
+                     td_file%i_n2d=td_file%i_n2d+1
+                     td_file%i_rhd=td_file%i_rhd+1
+                  CASE(3,4)
+                     td_file%i_n3d=td_file%i_n3d+1
+                     td_file%i_rhd=td_file%i_rhd+td_file%t_dim(3)%i_len
+               END SELECT
+
+               ! look for depth id
+               IF( INDEX(TRIM(fct_lower(td_file%t_var(ii)%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) )
+                     ENDIF
                   ENDIF
                ENDIF
-            ENDIF
-
-            ! look for time id
-            IF( INDEX(TRIM(td_file%t_var(ji)%c_name),'time') /= 0 )THEN
-               IF( td_file%i_timeid == 0 )THEN
-                  td_file%i_timeid=ji
-               ELSE
-                  il_attid=0
-                  IF( ASSOCIATED(td_file%t_var(ji)%t_att) )THEN
-                     il_attid=att_get_id(td_file%t_var(ji)%t_att(:),'calendar')
-                  ENDIF
-                  IF( il_attid /= 0 )THEN
+
+               ! look for time id
+               IF( INDEX(TRIM(fct_lower(td_file%t_var(ii)%c_name)),'time')/=0 )THEN
+                  IF( td_file%i_timeid == 0 )THEN
                      td_file%i_timeid=ji
-                  !ELSE
-                  !   print *,'error'
-                  !   CALL logger_error("IOM OPEN: find more than one "//&
-                  !   &                 "time variable in file "//&
-                  !   &                 TRIM(td_file%c_name) )
+                  ELSE
+                     il_attid=0
+                     IF( ASSOCIATED(td_file%t_var(ii)%t_att) )THEN
+                        il_attid=att_get_id(td_file%t_var(ii)%t_att(:),'calendar')
+                     ENDIF
+                     IF( il_attid /= 0 )THEN
+                        td_file%i_timeid=ji
+                     !ELSE
+                     !   CALL logger_error("IOM CDF GET FILE VAR: find more "//&
+                     !   &                 "than one time variable in file "//&
+                     !   &                 TRIM(td_file%c_name) )
+                     ENDIF
                   ENDIF
                ENDIF
+
             ENDIF
-
          ENDDO
+
+         CALL var_clean(tl_var(:))
+         DEALLOCATE(tl_var)
 
       ELSE
@@ -526,5 +584,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -567,5 +625,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 +643,5 @@
       INTEGER(i4)       :: il_len
       CHARACTER(LEN=lc) :: cl_name
+      LOGICAL           :: ll_use
       !----------------------------------------------------------------
 
@@ -592,6 +653,4 @@
 
       ELSE      
-
-         iom_cdf__read_dim_id%i_id=id_dimid
 
          CALL logger_trace( &
@@ -601,9 +660,19 @@
          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)
-
-      ENDIF
+         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
+
+      iom_cdf__read_dim_id%i_id=id_dimid
 
    END FUNCTION iom_cdf__read_dim_id
@@ -613,5 +682,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -634,5 +703,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 +710,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 +722,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -714,9 +784,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 )
@@ -727,7 +797,7 @@
                IF( LEN(cl_value) < il_len )THEN
 
-                  CALL logger_error( &
-                  &  " IOM CDF READ ATT: not enough space to put attribute "//&
-                  &  TRIM(cl_name) )
+                  CALL logger_warn( &
+                  &  " IOM CDF READ ATT: not enough space to put "//&
+                  &  "attribute "//TRIM(cl_name) )
 
                ELSE
@@ -737,5 +807,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 +828,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 +843,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 +852,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 +867,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 +876,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 +890,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 +899,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 +914,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 +923,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 +943,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -902,5 +972,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 +988,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -976,5 +1046,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -1043,5 +1113,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1085,5 +1155,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1148,5 +1218,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1199,7 +1269,9 @@
    !
    !> @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.
+   !> @date September, 2015
+   !> - manage useless (dummy) attribute
    !
    !> @param[in] td_file   file structure
@@ -1229,4 +1301,5 @@
 
       ! loop indices
+      INTEGER(i4) :: ji
       !----------------------------------------------------------------
       ! check if file opened
@@ -1240,5 +1313,5 @@
 
          ! inquire variable
-         CALL logger_trace( &
+         CALL logger_debug( &
          &  " IOM CDF READ VAR META: inquire variable "//&
          &  TRIM(fct_str(id_varid))//&
@@ -1253,7 +1326,9 @@
          &                                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(:) )
+         tl_dim(:)=iom_cdf__read_var_dim( td_file, il_ndim, cl_name, il_dimid(:) )
+
          IF( il_natt /= 0 )THEN
             ALLOCATE( tl_att(il_natt) )
@@ -1276,10 +1351,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 +1386,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 "//&
@@ -1331,4 +1406,11 @@
          &                                tl_att(:), id_id=id_varid )
 
+         !! look for dummy attribute
+         DO ji=il_natt,1,-1
+            IF( att_is_dummy(tl_att(ji)) )THEN
+               CALL var_del_att(iom_cdf__read_var_meta, tl_att(ji))
+            ENDIF
+         ENDDO
+
          ! clean
          CALL dim_clean(tl_dim(:))
@@ -1351,18 +1433,26 @@
    !> So the array of dimension structure of a variable is always compose of 4
    !> dimension (use or not). 
-   !
-   !> @author J.Paul
-   !> - November, 2013- Initial Version
-   !
+   !>
+   !> @warn dummy dimension are not used. 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - Bug fix: use order to disorder table (see dim_init)
+   !> @date September, 2015
+   !> - check dummy dimension
+   !>
    !> @param[in] td_file   file structure
    !> @param[in] id_ndim   number of dimension
+   !> @param[in] cd_name   variable name
    !> @param[in] id_dimid  array of dimension id
    !> @return array dimension structure 
    !-------------------------------------------------------------------
-   FUNCTION iom_cdf__read_var_dim(td_file, id_ndim, id_dimid)
+   FUNCTION iom_cdf__read_var_dim(td_file, id_ndim, cd_name, id_dimid)
       IMPLICIT NONE
       ! Argument      
       TYPE(TFILE),               INTENT(IN) :: td_file
       INTEGER(i4),               INTENT(IN) :: id_ndim
+      CHARACTER(LEN=*)         , INTENT(IN) :: cd_name
       INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_dimid
 
@@ -1371,5 +1461,5 @@
 
       ! local variable
-      INTEGER(i4), DIMENSION(ip_maxdim) :: il_2xyzt
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_xyzt2
 
       TYPE(TDIM) , DIMENSION(ip_maxdim) :: tl_dim
@@ -1377,4 +1467,5 @@
       ! loop indices
       INTEGER(i4) :: ji
+      INTEGER(i4) :: ii
       !----------------------------------------------------------------
 
@@ -1391,21 +1482,37 @@
          CALL dim_clean(tl_dim(:))
 
-      ELSE IF( id_ndim > 0 .AND. id_ndim <= 4 )THEN
-
-
+      ELSE IF( id_ndim > 0 )THEN
+
+
+         ii=1
          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
-
-            ! 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 )
+
+            !!! check no dummy dimension to be used
+            IF( ANY(td_file%t_dim(:)%i_id == id_dimid(ji)) )THEN
+               IF( ii > ip_maxdim )THEN
+                  CALL logger_error(" IOM CDF READ VAR DIM: "//&
+                  &  "too much dimensions for variable "//&
+                  &  TRIM(cd_name)//". check dummy configuration file.")
+               ENDIF
+
+               CALL logger_debug( " IOM CDF READ VAR DIM: get variable "//&
+                  &  "dimension "//TRIM(fct_str(ji)) )
+
+               il_xyzt2(ii)=td_file%t_dim(id_dimid(ji))%i_xyzt2
+
+               ! read dimension information
+               tl_dim(ii) = dim_init( td_file%t_dim(il_xyzt2(ii))%c_name, &
+               &                      td_file%t_dim(il_xyzt2(ii))%i_len )
+            
+               ii=ii+1
+            ELSE
+               CALL logger_debug( " IOM CDF READ VAR DIM: dummy variable "//&
+               &  "dimension "//TRIM(fct_str(ji))//" not used." )
+            ENDIF
          ENDDO
 
          ! reorder dimension to ('x','y','z','t')
          CALL dim_reorder(tl_dim(:))
-      
+ 
          iom_cdf__read_var_dim(:)=dim_copy(tl_dim(:))
 
@@ -1413,9 +1520,4 @@
          CALL dim_clean(tl_dim(:))
 
-      ELSE
-
-         CALL logger_error(" IOM CDF READ VAR DIM: can't manage "//&
-         &              TRIM(fct_str(id_ndim))//" dimension(s)" )
-
       ENDIF
 
@@ -1426,5 +1528,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -1475,5 +1577,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 +1586,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 +1597,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 +1620,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 +1627,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 +1666,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 +1674,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 +1702,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 +1764,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 +1781,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 +1810,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 +1846,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 +1905,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1798,5 +1927,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 +1942,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 +1952,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 +1963,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1859,5 +1988,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 +2005,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 +2011,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 +2020,7 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2015
+   !> - do not force to use zero as FillValue for any meshmask variable
    !
    !> @param[inout] td_file   file structure
@@ -1917,15 +2048,12 @@
          ! 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
-
-         ! check variable dimension expected
-         CALL var_check_dim(td_var)
 
          ll_chg=.TRUE.
@@ -1938,10 +2066,29 @@
             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', &
+                  & 'e1t','e1u','e1v','e1f',         &
+                  & 'e2t','e2u','e2v','e2f','ff',    &
+                  & 'gcost','gcosu','gcosv','gcosf', &
+                  & 'gsint','gsinu','gsinv','gsinf', &
+                  & 'mbathy','misf','isf_draft',     &
+                  & 'hbatt','hbatu','hbatv','hbatf', &
+                  & 'gsigt','gsigu','gsigv','gsigf', &
+                  & 'e3t_0','e3u_0','e3v_0','e3w_0', &
+                  & 'e3f_0','gdepw_1d','gdept_1d',   &
+                  & 'e3tp','e3wp','gdepw_0','rx1',   &
+                  & 'gdept_0','gdepu','gdepv',       &
+                  & 'hdept','hdepw','e3w_1d','e3t_1d',&
+                  & 'tmask','umask','vmask','fmask'  )
+                  ! do not change for coordinates and meshmask variables
+            END SELECT
          ENDIF
 
@@ -1957,5 +2104,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 +2122,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -2002,9 +2149,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 +2175,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,46 +2199,49 @@
 
       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) )
 
-         IF( tl_var%t_att(ji)%i_type == NF90_CHAR )THEN
-            IF( TRIM(tl_var%t_att(ji)%c_value) /= '' )THEN
-               il_status = NF90_PUT_ATT(td_file%i_id, iom_cdf__write_var_def, &
-               &                        TRIM(tl_var%t_att(ji)%c_name),        &
-               &                        TRIM(tl_var%t_att(ji)%c_value)        )
-               CALL iom_cdf__check(il_status)
-            ENDIF
-         ELSE
-            SELECT CASE(tl_var%t_att(ji)%i_type)
-               CASE(NF90_BYTE)
-                  il_status = NF90_PUT_ATT(td_file%i_id,                   &
-                  &                        iom_cdf__write_var_def,         &
-                  &                        TRIM(tl_var%t_att(ji)%c_name),  &
-                  &                        INT(tl_var%t_att(ji)%d_value(:),i1))
-               CASE(NF90_SHORT)
-                  il_status = NF90_PUT_ATT(td_file%i_id,                   &
-                  &                        iom_cdf__write_var_def,         &
-                  &                        TRIM(tl_var%t_att(ji)%c_name),  &
-                  &                        INT(tl_var%t_att(ji)%d_value(:),i2))
-               CASE(NF90_INT)
-                  il_status = NF90_PUT_ATT(td_file%i_id,                   &
-                  &                        iom_cdf__write_var_def,         &
-                  &                        TRIM(tl_var%t_att(ji)%c_name),  &
-                  &                        INT(tl_var%t_att(ji)%d_value(:),i4))
-               CASE(NF90_FLOAT)
-                  il_status = NF90_PUT_ATT(td_file%i_id,                   &
-                  &                        iom_cdf__write_var_def,         &
-                  &                        TRIM(tl_var%t_att(ji)%c_name),  &
-                  &                        REAL(tl_var%t_att(ji)%d_value(:),sp))
-               CASE(NF90_DOUBLE)
-                  il_status = NF90_PUT_ATT(td_file%i_id,                   &
-                  &                        iom_cdf__write_var_def,         &
-                  &                        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)
+         ! 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
+
+         SELECT CASE(tl_var%t_att(ji)%i_type)
+            CASE(NF90_CHAR)
+               IF( TRIM(tl_var%t_att(ji)%c_value) /= '' )THEN
+                  il_status = NF90_PUT_ATT(td_file%i_id, iom_cdf__write_var_def, &
+                  &                        TRIM(tl_var%t_att(ji)%c_name),        &
+                  &                        TRIM(tl_var%t_att(ji)%c_value)        )
+               ENDIF
+            CASE(NF90_BYTE)
+               il_status = NF90_PUT_ATT(td_file%i_id,                   &
+               &                        iom_cdf__write_var_def,         &
+               &                        TRIM(tl_var%t_att(ji)%c_name),  &
+               &                        INT(tl_var%t_att(ji)%d_value(:),i1))
+            CASE(NF90_SHORT)
+               il_status = NF90_PUT_ATT(td_file%i_id,                   &
+               &                        iom_cdf__write_var_def,         &
+               &                        TRIM(tl_var%t_att(ji)%c_name),  &
+               &                        INT(tl_var%t_att(ji)%d_value(:),i2))
+            CASE(NF90_INT)
+               il_status = NF90_PUT_ATT(td_file%i_id,                   &
+               &                        iom_cdf__write_var_def,         &
+               &                        TRIM(tl_var%t_att(ji)%c_name),  &
+               &                        INT(tl_var%t_att(ji)%d_value(:),i4))
+            CASE(NF90_FLOAT)
+               il_status = NF90_PUT_ATT(td_file%i_id,                   &
+               &                        iom_cdf__write_var_def,         &
+               &                        TRIM(tl_var%t_att(ji)%c_name),  &
+               &                        REAL(tl_var%t_att(ji)%d_value(:),sp))
+            CASE(NF90_DOUBLE)
+               il_status = NF90_PUT_ATT(td_file%i_id,                   &
+               &                        iom_cdf__write_var_def,         &
+               &                        TRIM(tl_var%t_att(ji)%c_name),  &
+               &                        REAL(tl_var%t_att(ji)%d_value(:),dp))
+         END SELECT
+         CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ")
+
       ENDDO
 
@@ -2097,5 +2256,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,4 +2283,10 @@
       &  "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
@@ -2148,10 +2315,11 @@
 
       ! put value
-      CALL logger_trace( &
+      CALL logger_debug( &
       &  "IOM CDF WRITE VAR VALUE: put "//TRIM(td_var%c_name)//" value "//&
       &  "in file "//TRIM(td_file%c_name))
 
       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 ("//&
+         &  TRIM(td_var%c_name)//") :" )
 
       DEALLOCATE( dl_value )
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/iom_dom.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/iom_dom.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/iom_dom.f90	(revision 6440)
@@ -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
@@ -234,5 +234,5 @@
                CALL logger_error( &
                &  " IOM DOM 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
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/iom_mpp.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/iom_mpp.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/iom_mpp.f90	(revision 6440)
@@ -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
 
@@ -398,7 +415,7 @@
             ELSE
 
-               CALL logger_error( &
+               CALL logger_fatal( &
                &  " 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
@@ -607,8 +648,5 @@
          DO ji=1, td_mpp%i_nproc
             IF( td_mpp%t_proc(ji)%i_id /= 0 )THEN
-               !CALL file_del_att(td_mpp%t_proc(ji), 'periodicity')
-               !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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/iom_rstdimg.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/iom_rstdimg.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/iom_rstdimg.f90	(revision 6440)
@@ -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,6 +394,8 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
-   !
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2016
+   !> - mismatch with "halo" indices
+   !>
    !> @param[inout] td_file   file structure
    !-------------------------------------------------------------------
@@ -494,34 +496,22 @@
       ENDIF
 
-      tl_att=att_init( "DOMAIN_position_first", (/il_impp(il_area), il_jmpp(il_area)/))
+      tl_att=att_init( "SUBDOMAIN_I_left_bottom_indices", il_impp(:) )
       CALL file_move_att(td_file, tl_att)
-
-      tl_att=att_init( "DOMAIN_position_last", (/il_lci(il_area), il_lcj(il_area)/))
+      tl_att=att_init( "SUBDOMAIN_J_left_bottom_indices", il_jmpp(:) )
       CALL file_move_att(td_file, tl_att)
 
-      tl_att=att_init( "DOMAIN_halo_size_start", (/il_ldi(il_area), il_ldj(il_area)/))
+      tl_att=att_init( "SUBDOMAIN_I_dimensions", il_lci(:))
       CALL file_move_att(td_file, tl_att)
-
-      tl_att=att_init( "DOMAIN_halo_size_end", (/il_lei(il_area), il_lej(il_area)/))
+      tl_att=att_init( "SUBDOMAIN_J_dimensions", il_lcj(:))
       CALL file_move_att(td_file, tl_att)
 
-      tl_att=att_init( "DOMAIN_I_position_first", il_impp(:) )
+      tl_att=att_init( "SUBDOMAIN_I_first_indoor_indices", il_ldi(:))
       CALL file_move_att(td_file, tl_att)
-      tl_att=att_init( "DOMAIN_J_position_first", il_jmpp(:) )
+      tl_att=att_init( "SUBDOMAIN_J_first_indoor_indices", il_ldj(:))
       CALL file_move_att(td_file, tl_att)
 
-      tl_att=att_init( "DOMAIN_I_position_last", il_lci(:) )
+      tl_att=att_init( "SUBDOMAIN_I_last_indoor_indices", il_lei(:))
       CALL file_move_att(td_file, tl_att)
-      tl_att=att_init( "DOMAIN_J_position_last", il_lcj(:) )
-      CALL file_move_att(td_file, tl_att)
-
-      tl_att=att_init( "DOMAIN_I_halo_size_start", il_ldi(:) )
-      CALL file_move_att(td_file, tl_att)
-      tl_att=att_init( "DOMAIN_J_halo_size_start", il_ldj(:) )
-      CALL file_move_att(td_file, tl_att)
-
-      tl_att=att_init( "DOMAIN_I_halo_size_end", il_lei(:) )
-      CALL file_move_att(td_file, tl_att)
-      tl_att=att_init( "DOMAIN_J_halo_size_end", il_lej(:) )
+      tl_att=att_init( "SUBDOMAIN_J_last_indoor_indices", il_lej(:))
       CALL file_move_att(td_file, tl_att)
 
@@ -544,5 +534,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -636,5 +626,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -688,5 +678,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -733,5 +723,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -778,5 +768,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -820,5 +810,5 @@
    !
    !> @author J.Paul
-   !> - Nov, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -863,5 +853,5 @@
    !
    !> @author J.Paul
-   !> - Nov, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -907,5 +897,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -972,5 +962,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -1037,5 +1027,7 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2016
+   !> - use temporary array to read value from file
    !
    !> @param[in] td_file   file structure
@@ -1058,4 +1050,6 @@
       INTEGER(i4), DIMENSION(ip_maxdim)            :: il_start
       INTEGER(i4), DIMENSION(ip_maxdim)            :: il_count
+
+      REAL(dp),    DIMENSION(:,:,:)  , ALLOCATABLE :: dl_tmp
       REAL(dp),    DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
 
@@ -1141,7 +1135,10 @@
          IF( ALL(td_var%t_dim(1:3)%l_use) )THEN
             ! 3D variable (X,Y,Z)
+            ALLOCATE(dl_tmp( td_var%t_dim(1)%i_len, &
+            &                td_var%t_dim(2)%i_len, &
+            &                td_var%t_dim(4)%i_len) )           
             DO ji=1,td_var%t_dim(3)%i_len
                READ(td_file%i_id, IOSTAT=il_status, REC=td_var%i_rec +ji-1) &
-               &  dl_value(:,:,ji,:)
+               &  dl_tmp(:,:,:)
                CALL fct_err(il_status)
                IF( il_status /= 0 )THEN
@@ -1149,5 +1146,7 @@
                   &              TRIM(td_var%c_name))
                ENDIF
+               dl_value(:,:,ji,:)=dl_tmp(:,:,:)
             ENDDO
+            DEALLOCATE(dl_tmp)
          ELSEIF( ALL(td_var%t_dim(1:2)%l_use) )THEN
             ! 2D variable (X,Y)
@@ -1204,4 +1203,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 +1223,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date September, 2014
    !> - use iom_rstdimg__get_rec
@@ -1308,5 +1319,5 @@
    !>
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1413,6 +1424,8 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
-   !
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2016
+   !> - mismatch with "halo" indices
+   !>
    !> @param[inout] td_file   file structure
    !-------------------------------------------------------------------
@@ -1529,6 +1542,6 @@
       &         il_lei(il_nproc),  il_lej(il_nproc) )
 
-      ! get domain first poistion
-      il_ind=att_get_index( td_file%t_att, "DOMAIN_I_position_first" )
+      ! get left bottom indices
+      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_I_left_bottom_indices" )
       il_impp(:) = 0
       IF( il_ind /= 0 )THEN
@@ -1536,5 +1549,5 @@
       ENDIF
 
-      il_ind=att_get_index( td_file%t_att, "DOMAIN_J_position_first" )
+      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_J_left_bottom_indices" )
       il_jmpp(:) = 0
       IF( il_ind /= 0 )THEN
@@ -1542,11 +1555,11 @@
       ENDIF
       
-      ! check domain first poistion
+      ! check left bottom indices
       IF( ANY(il_impp(:)==0) .OR. ANY(il_jmpp(:)==0) )THEN
-         CALL logger_warn("WRITE FILE: no data for domain first position")
-      ENDIF
-
-      ! get domain last poistion
-      il_ind=att_get_index( td_file%t_att, "DOMAIN_I_position_last" )
+         CALL logger_warn("WRITE FILE: no data for subdomain left bottom indices")
+      ENDIF
+
+      ! get subdomain dimensions
+      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_I_dimensions" )
       il_lci(:) = 0
       IF( il_ind /= 0 )THEN
@@ -1554,5 +1567,5 @@
       ENDIF
 
-      il_ind=att_get_index( td_file%t_att, "DOMAIN_J_position_last" )
+      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_J_dimensions" )
       il_lcj(:) = 0
       IF( il_ind /= 0 )THEN
@@ -1560,11 +1573,11 @@
       ENDIF
 
-      ! check domain last poistion
+      ! check subdomain dimension
       IF( ANY(il_lci(:)==0) .OR. ANY(il_lcj(:)==0) )THEN
-         CALL logger_warn("WRITE FILE: no data for domain last position")
-      ENDIF
-
-      ! get halo size start
-      il_ind=att_get_index( td_file%t_att, "DOMAIN_I_halo_size_start" )
+         CALL logger_warn("WRITE FILE: no data for subdomain dimensions")
+      ENDIF
+
+      ! get first indoor indices
+      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_I_first_indoor_indices" )
       il_ldi(:) = 0
       IF( il_ind /= 0 )THEN
@@ -1572,5 +1585,5 @@
       ENDIF
 
-      il_ind=att_get_index( td_file%t_att, "DOMAIN_J_halo_size_start" )
+      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_J_first_indoor_indices" )
       il_ldj(:) = 0
       IF( il_ind /= 0 )THEN
@@ -1578,11 +1591,11 @@
       ENDIF
       
-      ! check halo size start
+      ! check first indoor indices
       IF( ANY(il_ldi(:)==0) .OR. ANY(il_ldj(:)==0) )THEN
-         CALL logger_warn("WRITE FILE: no data for halo size start")
-      ENDIF
-
-      ! get halo size end
-      il_ind=att_get_index( td_file%t_att, "DOMAIN_I_halo_size_end" )
+         CALL logger_warn("WRITE FILE: no data for subdomain first indoor indices")
+      ENDIF
+
+      ! get last indoor indices
+      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_I_last_indoor_indices" )
       il_lei(:) = 0
       IF( il_ind /= 0 )THEN
@@ -1590,5 +1603,5 @@
       ENDIF
 
-      il_ind=att_get_index( td_file%t_att, "DOMAIN_J_halo_size_end" )
+      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_J_last_indoor_indices" )
       il_lej(:) = 0
       IF( il_ind /= 0 )THEN
@@ -1596,7 +1609,7 @@
       ENDIF
 
-      ! check halo size end
+      ! check last indoor indices
       IF( ANY(il_lei(:)==0) .OR. ANY(il_lej(:)==0) )THEN
-         CALL logger_warn("WRITE FILE: no data for halo size end")
+         CALL logger_warn("WRITE FILE: no data for subdomain last indoor indices")
       ENDIF      
 
@@ -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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/logger.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/logger.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/logger.f90	(revision 6440)
@@ -6,6 +6,8 @@
 !
 ! DESCRIPTION:
-!> @brief This module create logger file and allow to fill it depending of verbosity.
+!> @brief This module manage log file.
 !> @details
+!> This module create log file and fill it depending of verbosity.
+!>
 !> verbosity could be choosen between :
 !>    - trace : Most detailed information.
@@ -16,7 +18,10 @@
 !> but not necessarily "wrong". 
 !>    - error : Other runtime errors or unexpected conditions.
-!>    - fatal : Severe errors that cause premature termination.<br />
-!>  default verbosity is warning
-!
+!>    - fatal : Severe errors that cause premature termination.
+!>    - none  : to not create and write any information in logger file.<br />
+!>       @warn in this case only FATAL ERROR will be detected.<br />
+!>
+!> @note default verbosity is warning
+!>
 !> If total number of error exceeded maximum number 
 !> authorized, program stop.
@@ -24,5 +29,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
@@ -34,4 +39,9 @@
 !> @code
 !> CALL logger_close()
+!> @endcode
+!>
+!> to clean logger file:<br/>
+!> @code
+!> CALL logger_clean()
 !> @endcode
 !>
@@ -103,4 +113,5 @@
 !>   CALL logger_footer()
 !>   CALL logger_close()
+!>   CALL logger_clean()
 !> @endcode
 !>
@@ -115,4 +126,5 @@
 !>   CALL logger_footer()
 !>   CALL logger_close()
+!>   CALL logger_clean()
 !> @endcode
 !
@@ -120,5 +132,10 @@
 !> 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
+!> @date January, 2016
+!> - add logger_clean subroutine
 !>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -140,4 +157,5 @@
    PUBLIC :: logger_open        !< create a log file with given verbosity
    PUBLIC :: logger_close       !< close log file
+   PUBLIC :: logger_clean       !< clean log structure
    PUBLIC :: logger_header      !< write header on log file
    PUBLIC :: logger_footer      !< write footer on log file
@@ -151,7 +169,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 +183,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 +190,6 @@
    &                  'warning ',&
    &                  'error   ',&
-   &                  'fatal   '/)
+   &                  'fatal   ',&
+   &                  'none    '/)
 
    TYPE(TLOGGER), SAVE :: tm_logger      !< logger structure
@@ -184,62 +205,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,40 +282,58 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !-------------------------------------------------------------------
    SUBROUTINE logger_close()
       IMPLICIT NONE
       ! local variable
-      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')
+      INTEGER(i4)   :: il_status
+      !----------------------------------------------------------------
+      IF( tm_logger%l_use )THEN
+         IF( tm_logger%i_id /= 0 )THEN
+            !tm_logger%i_id = 0
+            CLOSE( tm_logger%i_id, &
+            &      IOSTAT=il_status)      
+            CALL fct_err(il_status)
+         ELSE
+             CALL logger_open('logger.log')
+             CALL logger_header()
+             CALL logger_fatal('you must have create logger to use logger_close')
+         ENDIF
       ENDIF
 
    END SUBROUTINE logger_close
    !-------------------------------------------------------------------
+   !> @brief This subroutine clean a log structure.
+   !>
+   !> @author J.Paul
+   !> @date January, 2016 - Initial Version
+   !-------------------------------------------------------------------
+   SUBROUTINE logger_clean()
+      IMPLICIT NONE
+      ! local variable
+      TYPE(TLOGGER) :: tl_logger
+      !----------------------------------------------------------------
+      tm_logger = tl_logger
+
+   END SUBROUTINE logger_clean
+   !-------------------------------------------------------------------
    !> @brief This subroutine flushing output into log file.
    !>
    !> @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 +343,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !-------------------------------------------------------------------
    RECURSIVE SUBROUTINE logger_header()
@@ -299,17 +350,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 +372,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !-------------------------------------------------------------------
    SUBROUTINE logger_footer()
@@ -326,20 +379,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 +405,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_msg    message to write
@@ -361,19 +416,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 +441,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_msg    message to write
@@ -395,19 +452,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 +477,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_msg    message to write
@@ -429,19 +488,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 +513,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_msg    message to write
@@ -463,19 +524,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 +549,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_msg    message to write
@@ -500,30 +563,31 @@
       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
+            ! 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
+      ENDIF
    END SUBROUTINE logger_error
    !-------------------------------------------------------------------
@@ -532,5 +596,7 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2015
+   !> - stop program for FATAL ERROR if verbosity is none
    !
    !> @param[in] cd_msg message to write
@@ -541,21 +607,26 @@
       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
+      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
       ELSE
-          CALL logger_open('logger.log')
-          CALL logger_header()
-          CALL logger_fatal('you must have create logger to use logger_fatal')
+         PRINT *,"FATAL ERROR :"//TRIM(cd_msg)
+         STOP
       ENDIF
    END SUBROUTINE logger_fatal
@@ -565,5 +636,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 +686,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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/math.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/math.f90	(revision 6440)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/math.f90	(revision 6440)
@@ -0,0 +1,1287 @@
+!----------------------------------------------------------------------
+! 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')
+
+         ALLOCATE( dl_value(il_shape(1),il_shape(2),3) )
+         ! compute derivative in k-direction
+         DO jk=1,il_shape(3)
+
+            il_kmin=MAX(jk-1,1)
+            il_kmax=MIN(jk+1,il_shape(3))
+
+            IF( il_kmin==jk-1 .AND. il_kmax==jk+1 )THEN
+               k1=1  ; k2=3
+            ELSEIF( il_kmin==jk .AND. il_kmax==jk+1 )THEN
+               k1=1  ; k2=2
+            ELSEIF( il_kmin==jk-1 .AND. il_kmax==jk )THEN
+               k1=2  ; k2=3
+            ENDIF
+
+            dl_value(:,:,k1:k2)=dd_value(:,:,il_kmin:il_kmax)
+            IF( il_kmin == 1 )THEN
+               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
+               &                      DIM=3,         &
+               &                      SHIFT=-1,      &
+               &                      BOUNDARY=dl_value(:,:,1) )
+            ENDIF
+            IF( il_kmax == il_shape(3) )THEN
+               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
+               &                        DIM=3,         &
+               &                        SHIFT=1,       &
+               &                        BOUNDARY=dl_value(:,:,3))
+            ENDIF
+
+            IF( ll_discont )THEN
+               dl_min=MINVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
+               dl_max=MAXVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
+               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
+                  WHERE( dl_value(:,:,:) < 0_dp ) 
+                     dl_value(:,:,:) = dl_value(:,:,:)+360._dp
+                  END WHERE
+               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
+                  WHERE( dl_value(:,:,:) > 180 ) 
+                     dl_value(:,:,:) = dl_value(:,:,:)-180._dp
+                  END WHERE
+               ENDIF
+            ENDIF         
+
+            WHERE( dl_value(:,:,2) /= dd_fill .AND. & ! jk
+               &   dl_value(:,:,3) /= dd_fill .AND. & ! jk+1
+               &   dl_value(:,:,1) /= dd_fill )       ! jk-1
+
+               math_deriv_3D(:,:,jk)=&
+               &  ( dl_value(:,:,3) - dl_value(:,:,1) ) / &
+               &  REAL( il_kmax-il_kmin,dp)         
+
+            END WHERE
+
+         ENDDO
+
+      END SELECT
+
+      DEALLOCATE( dl_value )
+
+   END FUNCTION math_deriv_3D
+END MODULE math
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/merge_bathy.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/merge_bathy.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/merge_bathy.f90	(revision 6440)
@@ -9,9 +9,10 @@
 !> @file
 !> @brief 
-!> This program merge bathymetry file at boundaries.
+!> This program merges bathymetry file at boundaries.
 !>
 !> @details
 !> @section sec1 method
-!> Coarse grid Bathymetry is interpolated on fine grid. 
+!> Coarse grid Bathymetry is interpolated on fine grid 
+!> (nearest interpolation method is used).  
 !> Then fine Bathymetry and refined coarse bathymetry are merged at boundaries.<br/>
 !>    @f[BathyFine= Weight * BathyCoarse + (1-Weight)*BathyFine@f]
@@ -28,26 +29,28 @@
 !> @endcode
 !>    
-!>    merge_bathy.nam comprise 8 namelists:
+!> @note 
+!>    you could find a template of the namelist in templates directory.
+!>
+!>    merge_bathy.nam contains 7 namelists:
 !>       - logger namelist (namlog)
 !>       - config namelist (namcfg)
 !>       - coarse grid namelist (namcrs)
 !>       - fine grid namelist (namfin)
-!>       - variable namelist (namvar)
+!       - variable namelist (namvar)
 !>       - nesting namelist (namnst)
 !>       - boundary namelist (nambdy)
 !>       - output namelist (namout)
 !> 
-!>    @note 
-!>       All namelists have to be in file merge_bathy.nam, 
-!>       however variables of those namelists are all optional.
-!>
 !>    * _logger namelist (namlog)_:
 !>       - cn_logfile   : logger filename
 !>       - cn_verbosity : verbosity ('trace','debug','info',
-!>  'warning','error','fatal')
+!>  'warning','error','fatal','none')
 !>       - in_maxerror  : maximum number of error allowed
 !>
 !>    * _config namelist (namcfg)_:
-!>       - cn_varcfg : variable configuration file (see ./SIREN/cfg/variable.cfg)
+!>       - cn_varcfg : variable configuration file 
+!> (see ./SIREN/cfg/variable.cfg)
+!>       - cn_dumcfg : useless (dummy) configuration file, for useless 
+!> dimension or variable (see ./SIREN/cfg/dummy.cfg).
 !>
 !>    * _coarse grid namelist (namcrs)_:
@@ -60,24 +63,24 @@
 !>       - in_perio1 : NEMO periodicity index
 !>
-!>    * _variable namelist (namvar)_:
-!>       - 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/>
-!>          it is composed of the variable name follow by ':', 
-!>          then request(s) to be used on this variable.<br/> 
-!>          request could be:
-!>             - interpolation method
-!> 
-!>                requests must be separated by ';'.<br/>
-!>                order of requests does not matter.<br/>
-!>
-!>          informations about available method could be find in 
-!>          @ref interp modules.<br/>
-!>          Example: 'bathymetry: cubic'
-!>          @note 
-!>             If you do not specify a method which is required, 
-!>             default one is apply.
-!>          @warning 
-!>             variable name must be __Bathymetry__ here.
+!    * _variable namelist (namvar)_:
+!       - cn_varinfo : list of variable and extra information about request(s) 
+!       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:
+!             - int = interpolation method
+! 
+!                requests must be separated by ';'.<br/>
+!                order of requests does not matter.<br/>
+!
+!          informations about available method could be find in 
+!          @ref interp modules.<br/>
+!          Example: 'bathymetry: int=cubic'
+!          @note 
+!             If you do not specify a method which is required, 
+!             default one is apply.
+!          @warning 
+!             variable name must be __Bathymetry__ here.
 !>
 !>    * _nesting namelist (namnst)_:
@@ -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,9 @@
 !> @date Sepember, 2014 
 !> - add header for user
+!> @date July, 2015 
+!> - extrapolate all land points
+!> - add attributes with boundary string character (as in namelist)
+!> @date September, 2015
+!> - manage useless (dummy) variable, attributes, and dimension
 !>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -153,4 +162,5 @@
    CHARACTER(LEN=lc)                                  :: cl_namelist
    CHARACTER(LEN=lc)                                  :: cl_date
+   CHARACTER(LEN=lc)                                  :: cl_tmp
 
    INTEGER(i4)                                        :: il_narg
@@ -162,4 +172,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
@@ -198,4 +209,5 @@
    ! namcfg
    CHARACTER(LEN=lc)                       :: cn_varcfg = 'variable.cfg' 
+   CHARACTER(LEN=lc)                       :: cn_dumcfg = 'dummy.cfg'
 
    ! namcrs
@@ -207,6 +219,6 @@
    INTEGER(i4)                             :: in_perio1 = -1
 
-   ! namvar
-   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = ''
+!   ! namvar
+!   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = ''
 
    ! namnst
@@ -231,8 +243,10 @@
    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
-   &  cn_varcfg         !< variable configuration file
+   &  cn_varcfg, &       !< variable configuration file
+   &  cn_dumcfg          !< dummy configuration file
 
    NAMELIST /namcrs/ &  !< coarse grid namelist
@@ -244,8 +258,8 @@
    &  in_perio1         !< periodicity index
  
-   NAMELIST /namvar/ &  !< variable namelist
-   &  cn_varinfo        !< list of variable and interpolation 
-                        !< method to be used. 
-                        !< (ex: 'votemper|linear','vosaline|cubic' ) 
+!   NAMELIST /namvar/ &  !< variable namelist
+!   &  cn_varinfo        !< list of variable and interpolation 
+!                        !< method to be used. 
+!                        !< (ex: 'votemper|linear','vosaline|cubic' ) 
    
    NAMELIST /namnst/ &  !< nesting namelist
@@ -298,5 +312,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()
 
@@ -305,9 +319,16 @@
       CALL var_def_extra(TRIM(cn_varcfg))
 
+      ! get dummy variable
+      CALL var_get_dummy(TRIM(cn_dumcfg))
+      ! get dummy dimension
+      CALL dim_get_dummy(TRIM(cn_dumcfg))
+      ! get dummy attribute
+      CALL att_get_dummy(TRIM(cn_dumcfg))
+
       READ( il_fileid, NML = namcrs )
       READ( il_fileid, NML = namfin )
-      READ( il_fileid, NML = namvar )
-      ! add user change in extra information
-      CALL var_chg_extra(cn_varinfo)
+!      READ( il_fileid, NML = namvar )
+!      ! add user change in extra information
+!      CALL var_chg_extra(cn_varinfo)
 
       READ( il_fileid, NML = namnst )
@@ -510,4 +531,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 +620,5 @@
    CALL mpp_clean(tl_bathy0)
    DEALLOCATE(dl_weight)
+   CALL boundary_clean(tl_bdy(:))
 
    ! close log file
@@ -545,4 +641,6 @@
    !> @param[inout] dd_weight    array of weight
    !> @param[in] dd_fill         fillValue
+   !>
+   !> @todo improve boundary weight function
    !-------------------------------------------------------------------
    SUBROUTINE merge_bathy_get_boundary( td_bathy0, td_bathy1, td_bdy, &
@@ -605,4 +703,8 @@
                il_jmax1=td_bdy%t_seg(jl)%i_index
 
+               ! do not used grid point to compute 
+               ! boundaries indices (cf create_boundary)
+               ! as Bathymetry always on T point
+
             CASE('south')
 
@@ -618,4 +720,8 @@
                il_jmin1=td_bdy%t_seg(jl)%i_first
                il_jmax1=td_bdy%t_seg(jl)%i_last 
+
+               ! do not used grid point to compute 
+               ! boundaries indices (cf create_boundary)
+               ! as Bathymetry always on T point
 
             CASE('west')
@@ -692,4 +798,7 @@
             tl_var0=iom_dom_read_var(tl_bathy0,'Bathymetry',tl_dom0)
 
+            ! force to use nearest interpolation
+            tl_var0%c_interp(1)='nearest'
+
             ! close mpp files
             CALL iom_dom_close(tl_bathy0)
@@ -729,6 +838,14 @@
             CASE('north')
 
+!               ! npoint coarse
+!               il_width=td_bdy%t_seg(jl)%i_width-id_npoint
+!               ! compute "distance"
+!               dl_tmp1d(:)=(/(ji,ji=il_width-1,1,-1),(0,ji=1,id_npoint)/)
+!               ! compute weight on segment
+!               dl_tmp1d(:)= 0.5 + 0.5*COS( (dp_pi*dl_tmp1d(:)) / &
+!               &                           (il_width) )
+
                ! compute "distance"
-               dl_tmp1d(:)=(/(ji-1,ji=td_bdy%t_seg(jl)%i_width,1,-1)/)
+               dl_tmp1d(:)=(/(ji-1,ji=td_bdy%t_seg(jl)%i_width-1,1,-1),0/)
 
                ! compute weight on segment
@@ -746,5 +863,5 @@
 
                ! compute "distance"
-               dl_tmp1d(:)=(/(ji-1,ji=1,td_bdy%t_seg(jl)%i_width)/)               
+               dl_tmp1d(:)=(/0,(ji-1,ji=1,td_bdy%t_seg(jl)%i_width-1)/)               
 
                ! compute weight on segment
@@ -762,5 +879,5 @@
 
                ! compute "distance"
-               dl_tmp1d(:)=(/(ji-1,ji=td_bdy%t_seg(jl)%i_width,1,-1)/)
+               dl_tmp1d(:)=(/(ji-1,ji=td_bdy%t_seg(jl)%i_width-1,1,-1),0/)
 
                ! compute weight on segment
@@ -778,5 +895,5 @@
 
                ! compute "distance"
-               dl_tmp1d(:)=(/(ji-1,ji=1,td_bdy%t_seg(jl)%i_width)/)               
+               dl_tmp1d(:)=(/0,(ji-1,ji=1,td_bdy%t_seg(jl)%i_width-1)/)               
 
                ! compute weight on segment
@@ -908,7 +1025,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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/mpp.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/mpp.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/mpp.f90	(revision 6440)
@@ -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/>
@@ -198,5 +196,11 @@
 ! REVISION HISTORY:
 !> @date November, 2013 - Initial Version
-!> @date November, 2014 - Fix memory leaks bug
+!> @date November, 2014 
+!> - Fix memory leaks bug
+!> @date October, 2015
+!> - improve way to compute domain layout
+!> @date January, 2016
+!> - allow to print layout file (use lm_layout, hard coded)
+!> - add mpp__compute_halo and mpp__read_halo
 !
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -216,5 +220,6 @@
 
    ! type and variable
-   PUBLIC :: TMPP       !< mpp structure
+   PUBLIC  :: TMPP       !< mpp structure
+   PRIVATE :: TLAY       !< domain layout structure
 
    ! function and subroutine
@@ -241,13 +246,12 @@
    PUBLIC :: mpp_get_proc_size  !< get processor domain size
 
-   PRIVATE :: mpp__add_proc            ! add one proc strucutre in mpp structure
+   PRIVATE :: mpp__add_proc            ! add proc strucutre in mpp structure
+   PRIVATE :: mpp__add_proc_unit       ! add one proc strucutre in mpp structure
    PRIVATE :: mpp__del_proc            ! delete one proc strucutre in mpp structure
    PRIVATE :: mpp__del_proc_id         ! delete one proc strucutre in mpp structure, given procesor id
    PRIVATE :: mpp__del_proc_str        ! delete one proc strucutre in mpp structure, given procesor file structure 
    PRIVATE :: mpp__move_proc           ! overwrite proc strucutre in mpp structure
-   PRIVATE :: mpp__compute             ! compute domain decomposition
-   PRIVATE :: mpp__del_land            ! remove land sub domain from domain decomposition
+   PRIVATE :: mpp__create_layout       ! create mpp structure using domain layout
    PRIVATE :: mpp__optimiz             ! compute optimum domain decomposition
-   PRIVATE :: mpp__land_proc           ! check if processor is a land processor
    PRIVATE :: mpp__check_dim           ! check mpp structure dimension with proc or variable dimension
    PRIVATE :: mpp__check_proc_dim      ! check if processor and mpp structure use same dimension
@@ -269,7 +273,12 @@
    PRIVATE :: mpp__clean_unit          ! clean mpp strcuture
    PRIVATE :: mpp__clean_arr           ! clean array of mpp strcuture
+   PRIVATE :: mpp__compute_halo        ! compute subdomain indices defined with halo 
+   PRIVATE :: mpp__read_halo           ! read subdomain indices defined with halo
+
+   PRIVATE :: layout__init             ! initialise domain layout structure
+   PRIVATE :: layout__copy             ! clean domain layout structure
+   PRIVATE :: layout__clean            ! copy  domain layout structure
 
    TYPE TMPP !< mpp structure
-
       ! general 
       CHARACTER(LEN=lc)                  :: c_name = ''   !< base name 
@@ -286,5 +295,5 @@
 
       CHARACTER(LEN=lc)                  :: c_type = ''   !< type of the files (cdf, cdf4, dimg)
-      CHARACTER(LEN=lc)                  :: c_dom  = ''   !< type of domain (full, overlap, nooverlap)
+      CHARACTER(LEN=lc)                  :: c_dom  = ''   !< type of domain (full, noextra, nooverlap)
 
       INTEGER(i4)                        :: i_ndim = 0    !< number of dimensions used in mpp
@@ -292,10 +301,32 @@
 
       TYPE(TFILE), DIMENSION(:), POINTER :: t_proc => NULL()     !< files/processors composing mpp
-
    END TYPE
+
+   TYPE TLAY !< domain layout structure
+      INTEGER(i4)                          :: i_niproc = 0  !< number of processors following i
+      INTEGER(i4)                          :: i_njproc = 0  !< number of processors following j
+      INTEGER(i4)                          :: i_nland  = 0       !< number of land processors
+      INTEGER(i4)                          :: i_nsea   = 0       !< number of sea  processors
+      INTEGER(i4)                          :: i_mean   = 0       !< mean sea point per proc
+      INTEGER(i4)                          :: i_min    = 0       !< min  sea point per proc
+      INTEGER(i4)                          :: i_max    = 0       !< max  sea point per proc
+      INTEGER(i4), DIMENSION(:,:), POINTER :: i_msk   => NULL()  !< sea/land processor mask 
+      INTEGER(i4), DIMENSION(:,:), POINTER :: i_impp  => NULL()  !< i-indexes for mpp-subdomain left bottom 
+      INTEGER(i4), DIMENSION(:,:), POINTER :: i_jmpp  => NULL()  !< j-indexes for mpp-subdomain left bottom 
+      INTEGER(i4), DIMENSION(:,:), POINTER :: i_lci   => NULL()  !< i-dimensions of subdomain 
+      INTEGER(i4), DIMENSION(:,:), POINTER :: i_lcj   => NULL()  !< j-dimensions of subdomain 
+   END TYPE
+
+   ! module variable
+   INTEGER(i4) :: im_iumout = 44
+   LOGICAL     :: lm_layout =.FALSE.
 
    INTERFACE mpp_get_use
       MODULE PROCEDURE mpp__get_use_unit 
    END INTERFACE mpp_get_use
+
+   INTERFACE mpp__add_proc
+      MODULE PROCEDURE mpp__add_proc_unit 
+   END INTERFACE mpp__add_proc
 
    INTERFACE mpp_clean
@@ -352,5 +383,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 +410,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 +457,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 +486,5 @@
    !
    !> @author J.Paul
-   !> - Nov, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_mpp mpp structure
@@ -495,5 +527,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
@@ -561,9 +593,12 @@
             ALLOCATE( il_lci(td_mpp%i_niproc,td_mpp%i_njproc) )
             ALLOCATE( il_lcj(td_mpp%i_niproc,td_mpp%i_njproc) )
+            il_proc(:,:)=-1
+            il_lci(:,:) =-1
+            il_lcj(:,:) =-1
 
             DO jk=1,td_mpp%i_nproc
                ji=td_mpp%t_proc(jk)%i_iind
                jj=td_mpp%t_proc(jk)%i_jind
-               il_proc(ji,jj)=jk
+               il_proc(ji,jj)=jk-1
                il_lci(ji,jj)=td_mpp%t_proc(jk)%i_lci
                il_lcj(ji,jj)=td_mpp%t_proc(jk)%i_lcj
@@ -595,5 +630,4 @@
       ENDIF
 
-
 9400   FORMAT('     ***',20('*************',a3))
 9403   FORMAT('     *     ',20('         *   ',a3))
@@ -616,4 +650,9 @@
    !> @author J.Paul
    !> @date November, 2013 - Initial version
+   !> @date September, 2015
+   !> - allow to define dimension with array of dimension structure
+   !> @date January, 2016
+   !> - use RESULT to rename output
+   !> - mismatch with "halo" indices
    !
    !> @param[in] cd_file   file name of one file composing mpp domain
@@ -628,32 +667,42 @@
    !> @param[in] id_perio  NEMO periodicity index
    !> @param[in] id_pivot  NEMO pivot point index F(0),T(1)
+   !> @param[in] td_dim    array of dimension structure
    !> @return mpp structure
    !-------------------------------------------------------------------
-   TYPE(TMPP) FUNCTION mpp__init_mask(cd_file, id_mask,              &
-   &                                  id_niproc, id_njproc, id_nproc,&
-   &                                  id_preci, id_precj,            &
-                                      cd_type, id_ew, id_perio, id_pivot)
+   FUNCTION mpp__init_mask(cd_file, id_mask,                   &
+   &                       id_niproc, id_njproc, id_nproc,     &
+   &                       id_preci, id_precj,                 &
+   &                       cd_type, id_ew, id_perio, id_pivot, &
+   &                       td_dim )                            &
+   & RESULT(td_mpp)
       IMPLICIT NONE
       ! Argument
-      CHARACTER(LEN=*),            INTENT(IN) :: cd_file
-      INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_mask
-      INTEGER(i4),                 INTENT(IN), OPTIONAL :: id_niproc
-      INTEGER(i4),                 INTENT(IN), OPTIONAL :: id_njproc
-      INTEGER(i4),                 INTENT(IN), OPTIONAL :: id_nproc
-      INTEGER(i4),                 INTENT(IN), OPTIONAL :: id_preci
-      INTEGER(i4),                 INTENT(IN), OPTIONAL :: id_precj
-      CHARACTER(LEN=*),            INTENT(IN), OPTIONAL :: cd_type
-      INTEGER(i4),                 INTENT(IN), OPTIONAL :: id_ew
-      INTEGER(i4),                 INTENT(IN), OPTIONAL :: id_perio
-      INTEGER(i4),                 INTENT(IN), OPTIONAL :: id_pivot
+      CHARACTER(LEN=*),                  INTENT(IN) :: cd_file
+      INTEGER(i4), DIMENSION(:,:),       INTENT(IN) :: id_mask
+      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_niproc
+      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_njproc
+      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_nproc
+      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_preci
+      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_precj
+      CHARACTER(LEN=*),                  INTENT(IN), OPTIONAL :: cd_type
+      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_ew
+      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_perio
+      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_pivot
+      TYPE(TDIM) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: td_dim
+
+      ! function
+      TYPE(TMPP) :: td_mpp
 
       ! local variable
-      CHARACTER(LEN=lc)                :: cl_type
-
-      INTEGER(i4)      , DIMENSION(2) :: il_shape
-
-      TYPE(TDIM)                      :: tl_dim
-
-      TYPE(TATT)                      :: tl_att
+      CHARACTER(LEN=lc)                            :: cl_type
+
+      INTEGER(i4)      , DIMENSION(2)              :: il_shape
+
+      TYPE(TDIM)                                   :: tl_dim
+
+      TYPE(TATT)                                   :: tl_att
+
+      TYPE(TLAY)                                   :: tl_lay
+
       ! loop indices
       INTEGER(i4) :: ji
@@ -661,5 +710,5 @@
 
       ! clean mpp
-      CALL mpp_clean(mpp__init_mask)
+      CALL mpp_clean(td_mpp)
 
       ! check type
@@ -670,33 +719,41 @@
          SELECT CASE(TRIM(cd_type))
             CASE('cdf')
-               mpp__init_mask%c_type='cdf'
+               td_mpp%c_type='cdf'
             CASE('dimg')
-               mpp__init_mask%c_type='dimg'
+               td_mpp%c_type='dimg'
             CASE DEFAULT
                CALL logger_warn( "MPP INIT: type "//TRIM(cd_type)//&
                & " unknown. type dimg will be used for mpp "//&
-               &  TRIM(mpp__init_mask%c_name) )
-               mpp__init_mask%c_type='dimg'
+               &  TRIM(td_mpp%c_name) )
+               td_mpp%c_type='dimg'
          END SELECT
       ELSE
-         mpp__init_mask%c_type=TRIM(file_get_type(cd_file))
+         td_mpp%c_type=TRIM(file_get_type(cd_file))
       ENDIF
 
       ! get mpp name
-      mpp__init_mask%c_name=TRIM(file_rename(cd_file))
+      td_mpp%c_name=TRIM(file_rename(cd_file))
 
       ! get global domain dimension
       il_shape(:)=SHAPE(id_mask)
 
-      tl_dim=dim_init('X',il_shape(1))
-      CALL mpp_add_dim(mpp__init_mask, tl_dim)
-
-      tl_dim=dim_init('Y',il_shape(2))
-      CALL mpp_add_dim(mpp__init_mask, tl_dim)
-
-      ! clean
-      CALL dim_clean(tl_dim)
-
-      IF( (       PRESENT(id_niproc)  .AND. (.NOT. PRESENT(id_niproc))) .OR. &
+      IF( PRESENT(td_dim) )THEN
+         DO ji=1,ip_maxdim
+            IF( td_dim(ji)%l_use )THEN
+               CALL mpp_add_dim(td_mpp, td_dim(ji))
+            ENDIF
+         ENDDO
+      ELSE
+         tl_dim=dim_init('X',il_shape(1))
+         CALL mpp_add_dim(td_mpp, tl_dim)
+
+         tl_dim=dim_init('Y',il_shape(2))
+         CALL mpp_add_dim(td_mpp, tl_dim)
+
+         ! clean
+         CALL dim_clean(tl_dim)
+      ENDIF
+
+      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 "//&
@@ -704,125 +761,114 @@
       ELSE
          ! get number of processors following I and J
-         IF( PRESENT(id_niproc) ) mpp__init_mask%i_niproc=id_niproc
-         IF( PRESENT(id_njproc) ) mpp__init_mask%i_njproc=id_njproc
+         IF( PRESENT(id_niproc) ) td_mpp%i_niproc=id_niproc
+         IF( PRESENT(id_njproc) ) td_mpp%i_njproc=id_njproc
       ENDIF
 
       ! get maximum number of processors to be used
-      IF( PRESENT(id_nproc) ) mpp__init_mask%i_nproc = id_nproc
+      IF( PRESENT(id_nproc) ) td_mpp%i_nproc = id_nproc
 
       ! get overlap region length
-      IF( PRESENT(id_preci) ) mpp__init_mask%i_preci= id_preci
-      IF( PRESENT(id_precj) ) mpp__init_mask%i_precj= id_precj
+      IF( PRESENT(id_preci) ) td_mpp%i_preci= id_preci
+      IF( PRESENT(id_precj) ) td_mpp%i_precj= id_precj
 
       ! east-west overlap
-      IF( PRESENT(id_ew) ) mpp__init_mask%i_ew= id_ew
+      IF( PRESENT(id_ew) ) td_mpp%i_ew= id_ew
       ! NEMO periodicity
-      IF( PRESENT(id_perio) ) mpp__init_mask%i_perio= id_perio
-      IF( PRESENT(id_pivot) ) mpp__init_mask%i_pivot= id_pivot
-
-      IF( mpp__init_mask%i_nproc  /= 0 .AND. &
-      &   mpp__init_mask%i_niproc /= 0 .AND. &
-      &   mpp__init_mask%i_njproc /= 0 .AND. &
-      &   mpp__init_mask%i_nproc > &
-      &   mpp__init_mask%i_niproc * mpp__init_mask%i_njproc )THEN
+      IF( PRESENT(id_perio) ) td_mpp%i_perio= id_perio
+      IF( PRESENT(id_pivot) ) td_mpp%i_pivot= id_pivot
+
+      IF( td_mpp%i_nproc  /= 0 .AND. &
+      &   td_mpp%i_niproc /= 0 .AND. &
+      &   td_mpp%i_njproc /= 0 .AND. &
+      &   td_mpp%i_nproc > &
+      &   td_mpp%i_niproc * td_mpp%i_njproc )THEN
 
          CALL logger_error("MPP INIT: invalid domain decomposition ")
          CALL logger_debug("MPP INIT: "// &
-         & TRIM(fct_str(mpp__init_mask%i_nproc))//" > "//&
-         & TRIM(fct_str(mpp__init_mask%i_niproc))//" x "//&
-         & TRIM(fct_str(mpp__init_mask%i_njproc)) )
+         & TRIM(fct_str(td_mpp%i_nproc))//" > "//&
+         & TRIM(fct_str(td_mpp%i_niproc))//" x "//&
+         & TRIM(fct_str(td_mpp%i_njproc)) )
 
       ELSE
-
-         IF( mpp__init_mask%i_niproc /= 0 .AND. &
-         &   mpp__init_mask%i_njproc /= 0 )THEN
-            ! compute domain decomposition
-            CALL mpp__compute( mpp__init_mask )
-            ! remove land sub domain
-            CALL mpp__del_land( mpp__init_mask, id_mask )
-         ELSEIF( mpp__init_mask%i_nproc  /= 0 )THEN
+         IF( lm_layout )THEN
+            OPEN(im_iumout,FILE='processor.layout')
+            WRITE(im_iumout,*)
+            WRITE(im_iumout,*) ' optimisation de la partition'
+            WRITE(im_iumout,*) ' ----------------------------'
+            WRITE(im_iumout,*)
+         ENDIF
+
+         IF( td_mpp%i_niproc /= 0 .AND. &
+         &   td_mpp%i_njproc /= 0 )THEN
+            ! compute domain layout
+            tl_lay=layout__init( td_mpp, id_mask, td_mpp%i_niproc, td_mpp%i_njproc )
+            ! create mpp domain layout
+            CALL mpp__create_layout( td_mpp, tl_lay )
+            ! clean
+            CALL layout__clean( tl_lay )
+         ELSEIF( td_mpp%i_nproc  /= 0 )THEN
             ! optimiz
-            CALL mpp__optimiz( mpp__init_mask, id_mask )
+            CALL mpp__optimiz( td_mpp, id_mask, td_mpp%i_nproc )
 
          ELSE
             CALL logger_warn("MPP INIT: number of processor to be used "//&
             &                "not specify. force to one.")
-            mpp__init_mask%i_nproc  = 1
             ! optimiz
-            CALL mpp__optimiz( mpp__init_mask, id_mask )
+            CALL mpp__optimiz( td_mpp, id_mask, 1 )
          ENDIF
+
+
          CALL logger_info("MPP INIT: domain decoposition : "//&
-         &  'niproc('//TRIM(fct_str(mpp__init_mask%i_niproc))//') * '//&
-         &  'njproc('//TRIM(fct_str(mpp__init_mask%i_njproc))//') = '//&
-         &  'nproc('//TRIM(fct_str(mpp__init_mask%i_nproc))//')' )
+         &  'niproc('//TRIM(fct_str(td_mpp%i_niproc))//') * '//&
+         &  'njproc('//TRIM(fct_str(td_mpp%i_njproc))//') = '//&
+         &  'nproc('//TRIM(fct_str(td_mpp%i_nproc))//')' )
 
          ! get domain type
-         CALL mpp_get_dom( mpp__init_mask )
-
-         DO ji=1,mpp__init_mask%i_nproc
+         CALL mpp_get_dom( td_mpp )
+
+         DO ji=1,td_mpp%i_nproc
 
             ! get processor size
-            il_shape(:)=mpp_get_proc_size( mpp__init_mask, ji )
+            il_shape(:)=mpp_get_proc_size( td_mpp, ji )
 
             tl_dim=dim_init('X',il_shape(1))
-            CALL file_move_dim(mpp__init_mask%t_proc(ji), tl_dim)
+            CALL file_move_dim(td_mpp%t_proc(ji), tl_dim)
 
             tl_dim=dim_init('Y',il_shape(2))
-            CALL file_move_dim(mpp__init_mask%t_proc(ji), tl_dim)            
-
+            CALL file_move_dim(td_mpp%t_proc(ji), tl_dim)            
+
+            IF( PRESENT(td_dim) )THEN
+               IF( td_dim(jp_K)%l_use )THEN
+                  CALL file_move_dim(td_mpp%t_proc(ji), td_dim(jp_K))
+               ENDIF
+               IF( td_dim(jp_L)%l_use )THEN
+                  CALL file_move_dim(td_mpp%t_proc(ji), td_dim(jp_L))
+               ENDIF
+            ENDIF
             ! add type
-            mpp__init_mask%t_proc(ji)%c_type=TRIM(mpp__init_mask%c_type)
+            td_mpp%t_proc(ji)%c_type=TRIM(td_mpp%c_type)
 
             ! clean
             CALL dim_clean(tl_dim)
+
          ENDDO
 
          ! add global attribute
-         tl_att=att_init("DOMAIN_number_total",mpp__init_mask%i_nproc)
-         CALL mpp_add_att(mpp__init_mask, tl_att)
-
-         tl_att=att_init("DOMAIN_I_number_total",mpp__init_mask%i_niproc)
-         CALL mpp_add_att(mpp__init_mask, tl_att)
-
-         tl_att=att_init("DOMAIN_J_number_total",mpp__init_mask%i_njproc)
-         CALL mpp_add_att(mpp__init_mask, tl_att)
-
-         tl_att=att_init("DOMAIN_size_global",mpp__init_mask%t_dim(1:2)%i_len)
-         CALL mpp_add_att(mpp__init_mask, tl_att)
-
-         tl_att=att_init( "DOMAIN_I_position_first", &
-         &                mpp__init_mask%t_proc(:)%i_impp )
-         CALL mpp_add_att(mpp__init_mask, tl_att)
-
-         tl_att=att_init( "DOMAIN_J_position_first", &
-         &                mpp__init_mask%t_proc(:)%i_jmpp )
-         CALL mpp_add_att(mpp__init_mask, tl_att)
-
-         tl_att=att_init( "DOMAIN_I_position_last", &
-         &                mpp__init_mask%t_proc(:)%i_lci )
-         CALL mpp_add_att(mpp__init_mask, tl_att)
-
-         tl_att=att_init( "DOMAIN_J_position_last", &
-         &                mpp__init_mask%t_proc(:)%i_lcj )
-         CALL mpp_add_att(mpp__init_mask, tl_att)
-
-         tl_att=att_init( "DOMAIN_I_halo_size_start", &
-         &                mpp__init_mask%t_proc(:)%i_ldi )
-         CALL mpp_add_att(mpp__init_mask, tl_att)
-
-         tl_att=att_init( "DOMAIN_J_halo_size_start", &
-         &                mpp__init_mask%t_proc(:)%i_ldj )
-         CALL mpp_add_att(mpp__init_mask, tl_att)
-
-         tl_att=att_init( "DOMAIN_I_halo_size_end", &
-         &                mpp__init_mask%t_proc(:)%i_lei )
-         CALL mpp_add_att(mpp__init_mask, tl_att)
-
-         tl_att=att_init( "DOMAIN_J_halo_size_end", &
-         &                mpp__init_mask%t_proc(:)%i_lej )
-         CALL mpp_add_att(mpp__init_mask, tl_att)         
-
-         ! clean
-         CALL att_clean(tl_att)
+         tl_att=att_init("DOMAIN_number_total",td_mpp%i_nproc)
+         CALL mpp_add_att(td_mpp, tl_att)
+
+         tl_att=att_init("DOMAIN_LOCAL",TRIM(td_mpp%c_dom))
+         CALL mpp_add_att(td_mpp, tl_att)
+
+         tl_att=att_init("DOMAIN_I_number_total",td_mpp%i_niproc)
+         CALL mpp_add_att(td_mpp, tl_att)
+
+         tl_att=att_init("DOMAIN_J_number_total",td_mpp%i_njproc)
+         CALL mpp_add_att(td_mpp, tl_att)
+
+         tl_att=att_init("DOMAIN_size_global",td_mpp%t_dim(1:2)%i_len)
+         CALL mpp_add_att(td_mpp, tl_att)
+
+         CALL mpp__compute_halo(td_mpp) 
       ENDIF
 
@@ -881,4 +927,6 @@
          il_mask(:,:,:)=var_get_mask(td_var)
          
+         CALL logger_info("MPP INIT: mask compute from variable "//&
+            &             TRIM(td_var%c_name))
          mpp__init_var=mpp_init( cd_file, il_mask(:,:,1),       &
          &                       id_niproc, id_njproc, id_nproc,&
@@ -908,9 +956,9 @@
    !>    - DOMAIN_halo_size_end
    !>  or the file is assume to be no mpp file.
-   !>  
-   !> 
-   !>
-   !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2016
+   !> - mismatch with "halo" indices, use mpp__compute_halo
    !
    !> @param[in] td_file   file strcuture
@@ -930,16 +978,16 @@
 
       ! local variable
-      TYPE(TMPP)  :: tl_mpp
-      
-      TYPE(TFILE) :: tl_file
-      
-      TYPE(TDIM)  :: tl_dim
-
-      TYPE(TATT)  :: tl_att
-
-      INTEGER(i4) :: il_nproc
-      INTEGER(i4) :: il_attid
-
+      INTEGER(i4)               :: il_nproc
+      INTEGER(i4)               :: il_attid
       INTEGER(i4), DIMENSION(2) :: il_shape
+
+      TYPE(TDIM)                :: tl_dim
+
+      TYPE(TATT)                :: tl_att
+
+      TYPE(TFILE)               :: tl_file
+
+      TYPE(TMPP)                :: tl_mpp
+
       ! loop indices
       INTEGER(i4) :: ji
@@ -957,5 +1005,4 @@
             ! open file
             CALL iom_open(tl_file)
-
             ! read first file domain decomposition
             tl_mpp=mpp__init_file_cdf(tl_file)
@@ -1028,30 +1075,8 @@
             ! 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)
-
-            tl_att=att_init( "DOMAIN_I_position_first", mpp__init_file%t_proc(:)%i_impp )
-            CALL mpp_add_att(mpp__init_file, tl_att)
-
-            tl_att=att_init( "DOMAIN_J_position_first", mpp__init_file%t_proc(:)%i_jmpp )
-            CALL mpp_add_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)
-
-            tl_att=att_init( "DOMAIN_J_position_last", mpp__init_file%t_proc(:)%i_lcj )
-            CALL mpp_add_att(mpp__init_file, tl_att)
-
-            tl_att=att_init( "DOMAIN_I_halo_size_start", mpp__init_file%t_proc(:)%i_ldi )
-            CALL mpp_add_att(mpp__init_file, tl_att)
-
-            tl_att=att_init( "DOMAIN_J_halo_size_start", mpp__init_file%t_proc(:)%i_ldj )
-            CALL mpp_add_att(mpp__init_file, tl_att)
-
-            tl_att=att_init( "DOMAIN_I_halo_size_end", mpp__init_file%t_proc(:)%i_lei )
-            CALL mpp_add_att(mpp__init_file, tl_att)
-
-            tl_att=att_init( "DOMAIN_J_halo_size_end", mpp__init_file%t_proc(:)%i_lej )
-            CALL mpp_add_att(mpp__init_file, tl_att)
-            
+            CALL mpp_move_att(mpp__init_file, tl_att)
+
+            CALL mpp__compute_halo(mpp__init_file)
+ 
             ! clean
             CALL mpp_clean(tl_mpp)
@@ -1122,5 +1147,4 @@
       CALL file_clean(tl_file)
 
-      CALL logger_debug("MPP INIT READ: fin init_read ")
    END FUNCTION mpp__init_file
    !-------------------------------------------------------------------
@@ -1131,5 +1155,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - add only use dimension in MPP structure
+   !> @date January, 2016
+   !> - mismatch with "halo" indices, use mpp__read_halo
    !>
    !> @param[in] td_file   file strcuture
@@ -1163,6 +1191,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 +1219,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
@@ -1214,55 +1247,5 @@
             tl_proc%t_dim(:)=dim_copy(td_file%t_dim(:))
 
-            ! DOMAIN_position_first
-            il_attid = 0
-            IF( ASSOCIATED(td_file%t_att) )THEN
-               il_attid=att_get_id( td_file%t_att, "DOMAIN_position_first" )
-            ENDIF
-            IF( il_attid /= 0 )THEN
-               tl_proc%i_impp = INT(td_file%t_att(il_attid)%d_value(1))
-               tl_proc%i_jmpp = INT(td_file%t_att(il_attid)%d_value(2))
-            ELSE
-               tl_proc%i_impp = 1
-               tl_proc%i_jmpp = 1
-            ENDIF
-
-            ! DOMAIN_position_last
-            il_attid = 0
-            IF( ASSOCIATED(td_file%t_att) )THEN
-               il_attid=att_get_id( td_file%t_att, "DOMAIN_position_last" )
-            ENDIF
-            IF( il_attid /= 0 )THEN
-               tl_proc%i_lci = INT(td_file%t_att(il_attid)%d_value(1)) + tl_proc%i_impp
-               tl_proc%i_lcj = INT(td_file%t_att(il_attid)%d_value(2)) + tl_proc%i_jmpp
-            ELSE
-               tl_proc%i_lci = mpp__init_file_cdf%t_dim(1)%i_len
-               tl_proc%i_lcj = mpp__init_file_cdf%t_dim(2)%i_len
-            ENDIF
-
-            ! DOMAIN_halo_size_start
-            il_attid = 0
-            IF( ASSOCIATED(td_file%t_att) )THEN
-               il_attid=att_get_id( td_file%t_att, "DOMAIN_halo_size_start" )
-            ENDIF
-            IF( il_attid /= 0 )THEN
-               tl_proc%i_ldi = INT(td_file%t_att(il_attid)%d_value(1))
-               tl_proc%i_ldj = INT(td_file%t_att(il_attid)%d_value(2))
-            ELSE
-               tl_proc%i_ldi = 1
-               tl_proc%i_ldj = 1
-            ENDIF
-
-            ! DOMAIN_halo_size_end
-            il_attid = 0
-            IF( ASSOCIATED(td_file%t_att) )THEN
-               il_attid=att_get_id( td_file%t_att, "DOMAIN_halo_size_end" )
-            ENDIF
-            IF( il_attid /= 0 )THEN
-               tl_proc%i_lei = INT(td_file%t_att(il_attid)%d_value(1))
-               tl_proc%i_lej = INT(td_file%t_att(il_attid)%d_value(2))
-            ELSE
-               tl_proc%i_lei = mpp__init_file_cdf%t_dim(1)%i_len
-               tl_proc%i_lej = mpp__init_file_cdf%t_dim(2)%i_len
-            ENDIF
+            CALL mpp__read_halo(tl_proc, mpp__init_file_cdf%t_dim(:) )
 
             ! add attributes
@@ -1274,20 +1257,4 @@
             CALL file_move_att(tl_proc, tl_att)
 
-            tl_att=att_init( "DOMAIN_position_first", &
-            &                (/tl_proc%i_impp, tl_proc%i_jmpp /) )
-            CALL file_move_att(tl_proc, tl_att)
-
-            tl_att=att_init( "DOMAIN_position_last", &
-            &                (/tl_proc%i_lci, tl_proc%i_lcj /) )
-            CALL file_move_att(tl_proc, tl_att)
-
-            tl_att=att_init( "DOMAIN_halo_size_start", &
-            &                (/tl_proc%i_ldi, tl_proc%i_ldj /) )
-            CALL file_move_att(tl_proc, tl_att)
-
-            tl_att=att_init( "DOMAIN_halo_size_end", &
-            &                (/tl_proc%i_lei, tl_proc%i_lej /) )
-            CALL file_move_att(tl_proc, tl_att)
-
             ! add processor to mpp structure
             CALL mpp__add_proc(mpp__init_file_cdf, tl_proc)
@@ -1295,4 +1262,5 @@
             ! clean 
             CALL file_clean(tl_proc)
+            CALL dim_clean(tl_dim)
             CALL att_clean(tl_att)
          ENDIF
@@ -1303,5 +1271,6 @@
          &  " do not exist")
 
-      ENDIF      
+      ENDIF
+
    END FUNCTION mpp__init_file_cdf
    !-------------------------------------------------------------------
@@ -1312,6 +1281,8 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
-   !
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2016
+   !> - mismatch with "halo" indices, use mpp__compute_halo
+   !>
    !> @param[in] td_file   file strcuture
    !> @return mpp structure
@@ -1332,4 +1303,13 @@
       INTEGER(i4)       :: il_pni, il_pnj, il_pnij          ! domain decomposition
       INTEGER(i4)       :: il_area                          ! domain index
+
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lci
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ldi
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lei
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_impp
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lcj
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ldj
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lej
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jmpp
 
       LOGICAL           ::  ll_exist
@@ -1385,4 +1365,13 @@
             ALLOCATE( mpp__init_file_rstdimg%t_proc(il_pnij) , stat=il_status )
 
+            ALLOCATE(il_lci (il_pnij))
+            ALLOCATE(il_lcj (il_pnij))
+            ALLOCATE(il_ldi (il_pnij))
+            ALLOCATE(il_ldj (il_pnij))
+            ALLOCATE(il_lei (il_pnij))
+            ALLOCATE(il_lej (il_pnij))
+            ALLOCATE(il_impp(il_pnij))
+            ALLOCATE(il_jmpp(il_pnij))
+
             tl_proc=file_copy(td_file)
             ! remove dimension from file
@@ -1407,12 +1396,12 @@
             &     il_area,                         &
             &     il_iglo, il_jglo,                &
-            &     mpp__init_file_rstdimg%t_proc(:)%i_lci,    &
-            &     mpp__init_file_rstdimg%t_proc(:)%i_lcj,    &
-            &     mpp__init_file_rstdimg%t_proc(:)%i_ldi,    &
-            &     mpp__init_file_rstdimg%t_proc(:)%i_ldj,    &
-            &     mpp__init_file_rstdimg%t_proc(:)%i_lei,    &
-            &     mpp__init_file_rstdimg%t_proc(:)%i_lej,    &
-            &     mpp__init_file_rstdimg%t_proc(:)%i_impp,   &
-            &     mpp__init_file_rstdimg%t_proc(:)%i_jmpp
+            &     il_lci(1:il_pnij),    &
+            &     il_lcj(1:il_pnij),    &
+            &     il_ldi(1:il_pnij),    &
+            &     il_ldj(1:il_pnij),    &
+            &     il_lei(1:il_pnij),    &
+            &     il_lej(1:il_pnij),    &
+            &     il_impp(1:il_pnij),   &
+            &     il_jmpp(1:il_pnij)
             CALL fct_err(il_status)
             IF( il_status /= 0 )THEN
@@ -1420,4 +1409,22 @@
                &              TRIM(td_file%c_name))
             ENDIF
+
+            mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_lci = il_lci (1:il_pnij)
+            mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_lcj = il_lcj (1:il_pnij) 
+            mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_ldi = il_ldi (1:il_pnij) 
+            mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_ldj = il_ldj (1:il_pnij) 
+            mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_lei = il_lei (1:il_pnij) 
+            mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_lej = il_lej (1:il_pnij) 
+            mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_impp= il_impp(1:il_pnij)
+            mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_jmpp= il_jmpp(1:il_pnij)
+
+            DEALLOCATE(il_lci) 
+            DEALLOCATE(il_lcj) 
+            DEALLOCATE(il_ldi) 
+            DEALLOCATE(il_ldj) 
+            DEALLOCATE(il_lei) 
+            DEALLOCATE(il_lej) 
+            DEALLOCATE(il_impp)
+            DEALLOCATE(il_jmpp)
 
             ! global domain size
@@ -1431,4 +1438,5 @@
 
             DO ji=1,mpp__init_file_rstdimg%i_nproc
+
                ! get file name
                cl_file =  file_rename(td_file%c_name,ji)
@@ -1441,23 +1449,4 @@
                CALL file_move_att(mpp__init_file_rstdimg%t_proc(ji), tl_att) 
 
-               tl_att=att_init( "DOMAIN_position_first", &
-               &                (/mpp__init_file_rstdimg%t_proc(ji)%i_impp, &
-               &                  mpp__init_file_rstdimg%t_proc(ji)%i_jmpp /) )
-               CALL file_move_att(mpp__init_file_rstdimg%t_proc(ji), tl_att)
-
-               tl_att=att_init( "DOMAIN_position_last", &
-               &                (/mpp__init_file_rstdimg%t_proc(ji)%i_lci, &
-               &                  mpp__init_file_rstdimg%t_proc(ji)%i_lcj /) )
-               CALL file_move_att(mpp__init_file_rstdimg%t_proc(ji), tl_att)
-
-               tl_att=att_init( "DOMAIN_halo_size_start", &
-               &                (/mpp__init_file_rstdimg%t_proc(ji)%i_ldi, &
-               &                  mpp__init_file_rstdimg%t_proc(ji)%i_ldj /) )
-               CALL file_move_att(mpp__init_file_rstdimg%t_proc(ji), tl_att)               
-
-               tl_att=att_init( "DOMAIN_halo_size_end", &
-               &                (/mpp__init_file_rstdimg%t_proc(ji)%i_lei, &
-               &                  mpp__init_file_rstdimg%t_proc(ji)%i_lej /) )
-               CALL file_move_att(mpp__init_file_rstdimg%t_proc(ji), tl_att)
             ENDDO
  
@@ -1482,35 +1471,7 @@
             CALL mpp_move_att(mpp__init_file_rstdimg, tl_att)
 
-            tl_att=att_init( "DOMAIN_I_position_first", &
-            &                 mpp__init_file_rstdimg%t_proc(:)%i_impp )
-            CALL mpp_move_att(mpp__init_file_rstdimg, tl_att)
-
-            tl_att=att_init( "DOMAIN_J_position_first", &
-            &                 mpp__init_file_rstdimg%t_proc(:)%i_jmpp )
-            CALL mpp_move_att(mpp__init_file_rstdimg, tl_att)
-
-            tl_att=att_init( "DOMAIN_I_position_last", &
-            &                 mpp__init_file_rstdimg%t_proc(:)%i_lci )
-            CALL mpp_move_att(mpp__init_file_rstdimg, tl_att)
-
-            tl_att=att_init( "DOMAIN_J_position_last", &
-            &                 mpp__init_file_rstdimg%t_proc(:)%i_lcj )
-            CALL mpp_move_att(mpp__init_file_rstdimg, tl_att)
-
-            tl_att=att_init( "DOMAIN_I_halo_size_start", &
-            &                 mpp__init_file_rstdimg%t_proc(:)%i_ldi )
-            CALL mpp_move_att(mpp__init_file_rstdimg, tl_att)
-
-            tl_att=att_init( "DOMAIN_J_halo_size_start", &
-            &                 mpp__init_file_rstdimg%t_proc(:)%i_ldj )
-            CALL mpp_move_att(mpp__init_file_rstdimg, tl_att)
-
-            tl_att=att_init( "DOMAIN_I_halo_size_end", &
-            &                 mpp__init_file_rstdimg%t_proc(:)%i_lei )
-            CALL mpp_move_att(mpp__init_file_rstdimg, tl_att)
-
-            tl_att=att_init( "DOMAIN_J_halo_size_end", &
-            &                 mpp__init_file_rstdimg%t_proc(:)%i_lej )
-            CALL mpp_move_att(mpp__init_file_rstdimg, tl_att)
+            CALL mpp_get_dom( mpp__init_file_rstdimg )
+
+            CALL mpp__compute_halo( mpp__init_file_rstdimg )
 
             ! clean
@@ -1532,5 +1493,5 @@
    !
    !> @author J.Paul
-   !> - Nov, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_mpp    mpp structure
@@ -1594,5 +1555,5 @@
       ! Argument
       TYPE(TMPP), INTENT(INOUT) :: td_mpp
-      TYPE(TVAR), INTENT(IN)    :: td_var
+      TYPE(TVAR), INTENT(INOUT) :: td_var
 
       ! local variable
@@ -1624,8 +1585,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 +1591,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
@@ -1643,4 +1603,7 @@
                ! check used dimension 
                IF( mpp__check_dim(td_mpp, td_var) )THEN
+         
+                  ! check variable dimension expected
+                  CALL var_check_dim(td_var)
 
                   ! update dimension if need be
@@ -1675,5 +1638,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_mpp    mpp structure
@@ -1840,4 +1803,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 +1817,5 @@
       ! local variable
       INTEGER(i4)       :: il_varid
+      TYPE(TVAR)        :: tl_var
       !----------------------------------------------------------------
       ! check if mpp exist
@@ -1882,5 +1848,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
@@ -1908,5 +1875,5 @@
       TYPE(TVAR) :: tl_var
       !----------------------------------------------------------------
-      ! copy variable
+      ! copy variablie
       tl_var=var_copy(td_var)
 
@@ -1935,5 +1902,5 @@
    !> - check proc type
    !-------------------------------------------------------------------
-   SUBROUTINE mpp__add_proc( td_mpp, td_proc )
+   SUBROUTINE mpp__add_proc_unit( td_mpp, td_proc )
       IMPLICIT NONE
       ! Argument
@@ -1950,4 +1917,12 @@
       CHARACTER(LEN=lc)                            :: cl_name
       !----------------------------------------------------------------
+
+!      ALLOCATE(tl_proc(1))
+!      tl_proc(1)=file_copy(td_proc)
+!
+!      CALL mpp__add_proc(td_mpp, tl_proc(:))
+!
+!      CALL file_clean(tl_proc(:))
+!      DEALLOCATE(tl_proc)
 
       ! check file name
@@ -2049,5 +2024,6 @@
 
       ENDIF
-   END SUBROUTINE mpp__add_proc
+
+   END SUBROUTINE mpp__add_proc_unit
    !-------------------------------------------------------------------
    !> @brief
@@ -2193,5 +2169,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 +2186,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 +2228,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 +2242,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 +2281,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_mpp mpp structure
@@ -2488,8 +2429,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 +2457,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 +2470,6 @@
 
       ! local variable
-      INTEGER(i4)       :: il_attid
+      INTEGER(i4) :: il_attid
+      TYPE(TATT)  :: tl_att
       !----------------------------------------------------------------
       ! check if mpp exist
@@ -2551,5 +2495,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 +2502,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
@@ -2599,33 +2544,352 @@
    !-------------------------------------------------------------------
    !> @brief
-   !>    This subroutine compute domain decomposition for niproc and njproc 
-   !> processors following I and J.
-   !>
+   !>    This function initialise domain layout
+   !> 
    !> @detail
-   !> To do so, it need to know :
-   !> - global domain dimension
-   !> - overlap region length
-   !> - number of processors following I and J
+   !> Domain layout is first compute, with domain dimension, overlap between subdomain,
+   !> and the number of processors following I and J.
+   !> Then the number of sea/land processors is compute with mask
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial version
+   !> @date October, 2015 - Initial version
+   !
+   !> @param[in] td_mpp mpp strcuture
+   !> @param[in] id_mask   sub domain mask (sea=1, land=0)
+   !> @pâram[in] id_niproc number of processors following I
+   !> @pâram[in] id_njproc number of processors following J
+   !> @return domain layout structure
+   !-------------------------------------------------------------------
+   FUNCTION layout__init( td_mpp, id_mask, id_niproc, id_njproc ) RESULT(td_lay)
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP)                 , INTENT(IN) :: td_mpp
+      INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_mask
+      INTEGER(i4)                , INTENT(IN) :: id_niproc
+      INTEGER(i4)                , INTENT(IN) :: id_njproc
+
+      ! function
+      TYPE(TLAY) :: td_lay
+
+      ! local variable
+      INTEGER(i4) :: ii1, ii2
+      INTEGER(i4) :: ij1, ij2
+
+      INTEGER(i4) :: il_ldi
+      INTEGER(i4) :: il_ldj
+      INTEGER(i4) :: il_lei
+      INTEGER(i4) :: il_lej
+
+      INTEGER(i4) :: il_isize !< i-direction maximum sub domain size 
+      INTEGER(i4) :: il_jsize !< j-direction maximum sub domain size
+      INTEGER(i4) :: il_resti !<  
+      INTEGER(i4) :: il_restj !<  
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      ! intialise
+      td_lay%i_niproc=id_niproc
+      td_lay%i_njproc=id_njproc
+
+      CALL logger_info( "MPP COMPUTE LAYOUT: compute domain layout with "//&
+      &               TRIM(fct_str(td_lay%i_niproc))//" x "//&
+      &               TRIM(fct_str(td_lay%i_njproc))//" processors")
+
+      ! maximum size of sub domain
+      il_isize = ((td_mpp%t_dim(1)%i_len - 2*td_mpp%i_preci + (td_lay%i_niproc-1))/ &
+      &           td_lay%i_niproc) + 2*td_mpp%i_preci
+      il_jsize = ((td_mpp%t_dim(2)%i_len - 2*td_mpp%i_precj + (td_lay%i_njproc-1))/ &
+      &           td_lay%i_njproc) + 2*td_mpp%i_precj
+
+      il_resti = MOD(td_mpp%t_dim(1)%i_len - 2*td_mpp%i_preci, td_lay%i_niproc)
+      il_restj = MOD(td_mpp%t_dim(2)%i_len - 2*td_mpp%i_precj, td_lay%i_njproc)
+      IF( il_resti == 0 ) il_resti = td_lay%i_niproc
+      IF( il_restj == 0 ) il_restj = td_lay%i_njproc
+
+      ! compute dimension of each sub domain
+      ALLOCATE( td_lay%i_lci(td_lay%i_niproc,td_lay%i_njproc) )
+      ALLOCATE( td_lay%i_lcj(td_lay%i_niproc,td_lay%i_njproc) )
+
+      td_lay%i_lci( 1          : il_resti       , : ) = il_isize
+      td_lay%i_lci( il_resti+1 : td_lay%i_niproc, : ) = il_isize-1
+
+      td_lay%i_lcj( : , 1          : il_restj       ) = il_jsize
+      td_lay%i_lcj( : , il_restj+1 : td_lay%i_njproc) = il_jsize-1
+
+      ! compute first index of each sub domain
+      ALLOCATE( td_lay%i_impp(td_lay%i_niproc,td_lay%i_njproc) )
+      ALLOCATE( td_lay%i_jmpp(td_lay%i_niproc,td_lay%i_njproc) )
+
+      td_lay%i_impp(:,:)=1
+      td_lay%i_jmpp(:,:)=1
+
+      IF( td_lay%i_niproc > 1 )THEN
+         DO jj=1,td_lay%i_njproc
+            DO ji=2,td_lay%i_niproc
+               td_lay%i_impp(ji,jj) = td_lay%i_impp(ji-1,jj) + &
+               &                       td_lay%i_lci (ji-1,jj) - 2*td_mpp%i_preci
+            ENDDO
+         ENDDO
+      ENDIF
+
+      IF( td_lay%i_njproc > 1 )THEN
+         DO jj=2,td_lay%i_njproc
+            DO ji=1,td_lay%i_niproc
+               td_lay%i_jmpp(ji,jj) = td_lay%i_jmpp(ji,jj-1) + &
+               &                       td_lay%i_lcj (ji,jj-1) - 2*td_mpp%i_precj
+            ENDDO
+         ENDDO 
+      ENDIF
+
+      ALLOCATE(td_lay%i_msk(td_lay%i_niproc,td_lay%i_njproc))
+      td_lay%i_msk(:,:)=0
+      ! init number of sea/land proc
+      td_lay%i_nsea=0
+      td_lay%i_nland=td_lay%i_njproc*td_lay%i_niproc
+
+      ! check if processor is land or sea
+      DO jj = 1,td_lay%i_njproc
+         DO ji = 1,td_lay%i_niproc
+
+            ! compute first and last indoor indices
+            ! west boundary
+            IF( ji == 1 )THEN
+               il_ldi = 1 
+            ELSE
+               il_ldi = 1 + td_mpp%i_preci
+            ENDIF
+
+            ! south boundary
+            IF( jj == 1 )THEN
+               il_ldj = 1 
+            ELSE
+               il_ldj = 1 + td_mpp%i_precj
+            ENDIF
+
+            ! east boundary
+            IF( ji == td_mpp%i_niproc )THEN
+               il_lei = td_lay%i_lci(ji,jj)
+            ELSE
+               il_lei = td_lay%i_lci(ji,jj) - td_mpp%i_preci
+            ENDIF
+
+            ! north boundary
+            IF( jj == td_mpp%i_njproc )THEN
+               il_lej = td_lay%i_lcj(ji,jj)
+            ELSE
+               il_lej = td_lay%i_lcj(ji,jj) - td_mpp%i_precj
+            ENDIF
+
+            ii1=td_lay%i_impp(ji,jj) + il_ldi - 1
+            ii2=td_lay%i_impp(ji,jj) + il_lei - 1
+
+            ij1=td_lay%i_jmpp(ji,jj) + il_ldj - 1
+            ij2=td_lay%i_jmpp(ji,jj) + il_lej - 1
+
+            td_lay%i_msk(ji,jj)=SUM( id_mask(ii1:ii2,ij1:ij2) )
+            IF( td_lay%i_msk(ji,jj) > 0 )THEN ! sea
+               td_lay%i_nsea =td_lay%i_nsea +1
+               td_lay%i_nland=td_lay%i_nland-1
+            ENDIF
+
+         ENDDO
+      ENDDO
+
+      CALL logger_info( "MPP COMPUTE LAYOUT: sea proc "//TRIM(fct_str(td_lay%i_nsea)))
+      CALL logger_info( "MPP COMPUTE LAYOUT: land proc "//TRIM(fct_str(td_lay%i_nland)))
+      CALL logger_info( "MPP COMPUTE LAYOUT: sum "//TRIM(fct_str( SUM(td_lay%i_msk(:,:)))))
+
+      td_lay%i_mean= SUM(td_lay%i_msk(:,:)) / td_lay%i_nsea
+      td_lay%i_min = MINVAL(td_lay%i_msk(:,:),td_lay%i_msk(:,:)/=0)
+      td_lay%i_max = MAXVAL(td_lay%i_msk(:,:))
+
+      IF( lm_layout )THEN
+         ! print info 
+         WRITE(im_iumout,*) ' '
+         WRITE(im_iumout,*) " jpni=",td_lay%i_niproc ," jpnj=",td_lay%i_njproc
+         WRITE(im_iumout,*) " jpi= ",il_isize," jpj= ",il_jsize
+         WRITE(im_iumout,*) " iresti=",td_mpp%i_preci," irestj=",td_mpp%i_precj
+
+
+         WRITE(im_iumout,*) ' nombre de processeurs       ',td_lay%i_niproc*td_lay%i_njproc
+         WRITE(im_iumout,*) ' nombre de processeurs mer   ',td_lay%i_nsea
+         WRITE(im_iumout,*) ' nombre de processeurs terre ',td_lay%i_nland
+         WRITE(im_iumout,*) ' moyenne de recouvrement     ',td_lay%i_mean
+         WRITE(im_iumout,*) ' minimum de recouvrement     ',td_lay%i_min
+         WRITE(im_iumout,*) ' maximum de recouvrement     ',td_lay%i_max
+      ENDIF
+
+   END FUNCTION layout__init
+   !-------------------------------------------------------------------
+   !> @brief 
+   !>  This subroutine clean domain layout strcuture.
+   !>
+   !> @author J.Paul
+   !> @date October, 2015 - Initial version
+   !>
+   !> @param[inout] td_lay domain layout strcuture
+   !-------------------------------------------------------------------
+   SUBROUTINE layout__clean( td_lay )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TLAY),  INTENT(INOUT) :: td_lay
+      !----------------------------------------------------------------
+
+      IF( ASSOCIATED(td_lay%i_msk) )THEN
+         DEALLOCATE(td_lay%i_msk)
+      ENDIF
+      IF( ASSOCIATED(td_lay%i_impp) )THEN
+         DEALLOCATE(td_lay%i_impp)
+      ENDIF
+      IF( ASSOCIATED(td_lay%i_jmpp) )THEN
+         DEALLOCATE(td_lay%i_jmpp)
+      ENDIF
+      IF( ASSOCIATED(td_lay%i_lci) )THEN
+         DEALLOCATE(td_lay%i_lci)
+      ENDIF
+      IF( ASSOCIATED(td_lay%i_lcj) )THEN
+         DEALLOCATE(td_lay%i_lcj)
+      ENDIF
+
+      td_lay%i_niproc=0
+      td_lay%i_njproc=0
+      td_lay%i_nland =0
+      td_lay%i_nsea  =0
+
+      td_lay%i_mean  =0
+      td_lay%i_min   =0
+      td_lay%i_max   =0
+
+   END SUBROUTINE layout__clean
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine copy domain layout structure in another one.
+   !>
+   !> @warning do not use on the output of a function who create or read a
+   !> structure (ex: tl_seg=seg__copy(seg__init()) is forbidden).
+   !> This will create memory leaks.
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>
+   !> @author J.Paul
+   !> @date October, 2015 - Initial Version
+   !
+   !> @param[in] td_lay   domain layout structure
+   !> @return copy of input domain layout structure
+   !-------------------------------------------------------------------
+   FUNCTION layout__copy( td_lay )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TLAY), INTENT(IN)  :: td_lay
+      ! function
+      TYPE(TLAY) :: layout__copy
+
+      ! local variable
+      INTEGER(i4), DIMENSION(2)                :: il_shape
+      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_tmp
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! copy scalar 
+      layout__copy%i_niproc   = td_lay%i_niproc
+      layout__copy%i_njproc   = td_lay%i_njproc
+      layout__copy%i_nland    = td_lay%i_nland 
+      layout__copy%i_nsea     = td_lay%i_nsea  
+      layout__copy%i_mean     = td_lay%i_mean  
+      layout__copy%i_min      = td_lay%i_min   
+      layout__copy%i_max      = td_lay%i_max   
+
+      ! copy pointers
+      IF( ASSOCIATED(layout__copy%i_msk) )THEN
+         DEALLOCATE(layout__copy%i_msk)
+      ENDIF
+      IF( ASSOCIATED(td_lay%i_msk) )THEN
+         il_shape(:)=SHAPE(td_lay%i_msk(:,:))
+         ALLOCATE( layout__copy%i_msk(il_shape(jp_I),il_shape(jp_J)) )
+         layout__copy%i_msk(:,:)=td_lay%i_msk(:,:)
+      ENDIF
+
+      IF( ASSOCIATED(layout__copy%i_msk) ) DEALLOCATE(layout__copy%i_msk)
+      IF( ASSOCIATED(td_lay%i_msk) )THEN
+         il_shape(:)=SHAPE(td_lay%i_msk(:,:))
+         ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J)))
+         il_tmp(:,:)=td_lay%i_msk(:,:)
+
+         ALLOCATE( layout__copy%i_msk(il_shape(jp_I),il_shape(jp_J)) )
+         layout__copy%i_msk(:,:)=il_tmp(:,:)
+
+         DEALLOCATE(il_tmp)
+      ENDIF
+
+      IF( ASSOCIATED(layout__copy%i_impp) ) DEALLOCATE(layout__copy%i_impp)
+      IF( ASSOCIATED(td_lay%i_impp) )THEN
+         il_shape(:)=SHAPE(td_lay%i_impp(:,:))
+         ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J)))
+         il_tmp(:,:)=td_lay%i_impp(:,:)
+
+         ALLOCATE( layout__copy%i_impp(il_shape(jp_I),il_shape(jp_J)) )
+         layout__copy%i_impp(:,:)=il_tmp(:,:)
+
+         DEALLOCATE(il_tmp)
+      ENDIF
+
+      IF( ASSOCIATED(layout__copy%i_jmpp) ) DEALLOCATE(layout__copy%i_jmpp)
+      IF( ASSOCIATED(td_lay%i_jmpp) )THEN
+         il_shape(:)=SHAPE(td_lay%i_jmpp(:,:))
+         ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J)))
+         il_tmp(:,:)=td_lay%i_jmpp(:,:)
+
+         ALLOCATE( layout__copy%i_jmpp(il_shape(jp_I),il_shape(jp_J)) )
+         layout__copy%i_jmpp(:,:)=il_tmp(:,:)
+
+         DEALLOCATE(il_tmp)
+      ENDIF
+
+      IF( ASSOCIATED(layout__copy%i_lci) ) DEALLOCATE(layout__copy%i_lci)
+      IF( ASSOCIATED(td_lay%i_lci) )THEN
+         il_shape(:)=SHAPE(td_lay%i_lci(:,:))
+         ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J)))
+         il_tmp(:,:)=td_lay%i_lci(:,:)
+
+         ALLOCATE( layout__copy%i_lci(il_shape(jp_I),il_shape(jp_J)) )
+         layout__copy%i_lci(:,:)=il_tmp(:,:)
+
+         DEALLOCATE(il_tmp)
+      ENDIF
+
+      IF( ASSOCIATED(layout__copy%i_lcj) ) DEALLOCATE(layout__copy%i_lcj)
+      IF( ASSOCIATED(td_lay%i_lcj) )THEN
+         il_shape(:)=SHAPE(td_lay%i_lcj(:,:))
+         ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J)))
+         il_tmp(:,:)=td_lay%i_lcj(:,:)
+
+         ALLOCATE( layout__copy%i_lcj(il_shape(jp_I),il_shape(jp_J)) )
+         layout__copy%i_lcj(:,:)=il_tmp(:,:)
+
+         DEALLOCATE(il_tmp)
+      ENDIF
+
+   END FUNCTION layout__copy
+   !-------------------------------------------------------------------
+   !> @brief
+   !>    This subroutine create mpp structure using domain layout
+   !>
+   !> @detail
+   !
+   !> @author J.Paul
+   !> @date October, 2015 - Initial version
    !
    !> @param[inout] td_mpp mpp strcuture
-   !-------------------------------------------------------------------
-   SUBROUTINE mpp__compute( td_mpp )
+   !> @param[in] td_lay domain layout structure
+   !-------------------------------------------------------------------
+   SUBROUTINE mpp__create_layout( td_mpp, td_lay )
       IMPLICIT NONE
       ! Argument
       TYPE(TMPP), INTENT(INOUT) :: td_mpp
+      TYPE(TLAY), INTENT(IN   ) :: td_lay
 
       ! local variable
-      INTEGER(i4)                              :: il_isize !< i-direction maximum sub domain size 
-      INTEGER(i4)                              :: il_jsize !< j-direction maximum sub domain size
-      INTEGER(i4)                              :: il_resti !<  
-      INTEGER(i4)                              :: il_restj !<  
-      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_nlci
-      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_nlcj
-      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_impp
-      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_jmpp
-
       CHARACTER(LEN=lc)                        :: cl_file
       TYPE(TFILE)                              :: tl_proc
@@ -2641,195 +2905,154 @@
       td_mpp%i_nproc=0
 
-      CALL logger_trace( "MPP COMPUTE: compute domain decomposition with "//&
-      &               TRIM(fct_str(td_mpp%i_niproc))//" x "//&
-      &               TRIM(fct_str(td_mpp%i_njproc))//" processors")
-      ! maximum size of sub domain
-      il_isize = ((td_mpp%t_dim(1)%i_len - 2*td_mpp%i_preci + (td_mpp%i_niproc-1))/ &
-      &           td_mpp%i_niproc) + 2*td_mpp%i_preci
-      il_jsize = ((td_mpp%t_dim(2)%i_len - 2*td_mpp%i_precj + (td_mpp%i_njproc-1))/ &
-      &           td_mpp%i_njproc) + 2*td_mpp%i_precj
-
-      il_resti = MOD(td_mpp%t_dim(1)%i_len - 2*td_mpp%i_preci, td_mpp%i_niproc)
-      il_restj = MOD(td_mpp%t_dim(2)%i_len - 2*td_mpp%i_precj, td_mpp%i_njproc)
-      IF( il_resti == 0 ) il_resti = td_mpp%i_niproc
-      IF( il_restj == 0 ) il_restj = td_mpp%i_njproc
-
-      ! compute dimension of each sub domain
-      ALLOCATE( il_nlci(td_mpp%i_niproc,td_mpp%i_njproc) )
-      ALLOCATE( il_nlcj(td_mpp%i_niproc,td_mpp%i_njproc) )
-
-      il_nlci( 1 : il_resti                , : ) = il_isize
-      il_nlci( il_resti+1 : td_mpp%i_niproc, : ) = il_isize-1
-
-      il_nlcj( : , 1 : il_restj                ) = il_jsize
-      il_nlcj( : , il_restj+1 : td_mpp%i_njproc) = il_jsize-1
-
-      ! compute first index of each sub domain
-      ALLOCATE( il_impp(td_mpp%i_niproc,td_mpp%i_njproc) )
-      ALLOCATE( il_jmpp(td_mpp%i_niproc,td_mpp%i_njproc) )
-
-      il_impp(:,:)=1
-      il_jmpp(:,:)=1
-
-      DO jj=1,td_mpp%i_njproc
-         DO ji=2,td_mpp%i_niproc
-            il_impp(ji,jj)=il_impp(ji-1,jj)+il_nlci(ji-1,jj)-2*td_mpp%i_preci
+      CALL logger_debug( "MPP CREATE LAYOUT: create domain decomposition with "//&
+      &               TRIM(fct_str(td_lay%i_niproc))//" x "//&
+      &               TRIM(fct_str(td_lay%i_njproc))//" = "//&
+      &               TRIM(fct_str(td_lay%i_nsea))//" processors")
+
+      IF( lm_layout )THEN
+         WRITE(im_iumout,*) ' choix optimum'
+         WRITE(im_iumout,*) ' ============='
+         WRITE(im_iumout,*)
+         ! print info 
+         WRITE(im_iumout,*) ' '
+         WRITE(im_iumout,*) " jpni=",td_lay%i_niproc ," jpnj=",td_lay%i_njproc
+         WRITE(im_iumout,*) " iresti=",td_mpp%i_preci," irestj=",td_mpp%i_precj
+
+
+         WRITE(im_iumout,*) ' nombre de processeurs       ',td_lay%i_niproc*td_lay%i_njproc
+         WRITE(im_iumout,*) ' nombre de processeurs mer   ',td_lay%i_nsea
+         WRITE(im_iumout,*) ' nombre de processeurs terre ',td_lay%i_nland
+         WRITE(im_iumout,*) ' moyenne de recouvrement     ',td_lay%i_mean
+         WRITE(im_iumout,*) ' minimum de recouvrement     ',td_lay%i_min
+         WRITE(im_iumout,*) ' maximum de recouvrement     ',td_lay%i_max
+      ENDIF
+
+      td_mpp%i_niproc=td_lay%i_niproc
+      td_mpp%i_njproc=td_lay%i_njproc
+      !td_mpp%i_nproc =td_lay%i_nsea
+
+      IF( td_mpp%i_niproc*td_mpp%i_njproc == td_lay%i_nsea )THEN
+         IF( td_lay%i_nsea == 1 )THEN
+            td_mpp%c_dom='full'
+         ELSE
+            td_mpp%c_dom='nooverlap'
+         ENDIF
+      ELSE
+            td_mpp%c_dom='noextra'
+      ENDIF
+      
+      jk=0
+      DO jj=1,td_lay%i_njproc
+         DO ji=1,td_lay%i_niproc
+
+            IF( td_lay%i_msk(ji,jj) >= 1 )THEN
+
+               ! get processor file name
+               cl_file=file_rename(td_mpp%c_name,jk)
+               ! initialise file structure
+               tl_proc=file_init(cl_file,td_mpp%c_type)
+
+               ! procesor id
+               tl_proc%i_pid=jk
+
+               tl_att=att_init("DOMAIN_number",tl_proc%i_pid)
+               CALL file_add_att(tl_proc, tl_att)
+
+               ! processor indices
+               tl_proc%i_iind=ji
+               tl_proc%i_jind=jj
+
+               ! fill processor dimension and first indices
+               tl_proc%i_impp = td_lay%i_impp(ji,jj)
+               tl_proc%i_jmpp = td_lay%i_jmpp(ji,jj)
+
+               tl_proc%i_lci  = td_lay%i_lci(ji,jj)
+               tl_proc%i_lcj  = td_lay%i_lcj(ji,jj)
+
+               ! compute first and last indoor indices
+               
+               ! west boundary
+               IF( ji == 1 )THEN
+                  tl_proc%i_ldi = 1 
+                  tl_proc%l_ctr = .TRUE.
+               ELSE
+                  tl_proc%i_ldi = 1 + td_mpp%i_preci
+               ENDIF
+
+               ! south boundary
+               IF( jj == 1 )THEN
+                  tl_proc%i_ldj = 1 
+                  tl_proc%l_ctr = .TRUE.
+               ELSE
+                  tl_proc%i_ldj = 1 + td_mpp%i_precj
+               ENDIF
+
+               ! east boundary
+               IF( ji == td_mpp%i_niproc )THEN
+                  tl_proc%i_lei = td_lay%i_lci(ji,jj)
+                  tl_proc%l_ctr = .TRUE.
+               ELSE
+                  tl_proc%i_lei = td_lay%i_lci(ji,jj) - td_mpp%i_preci
+               ENDIF
+
+               ! north boundary
+               IF( jj == td_mpp%i_njproc )THEN
+                  tl_proc%i_lej = td_lay%i_lcj(ji,jj)
+                  tl_proc%l_ctr = .TRUE.
+               ELSE
+                  tl_proc%i_lej = td_lay%i_lcj(ji,jj) - td_mpp%i_precj
+               ENDIF
+
+               ! add processor to mpp structure
+               CALL mpp__add_proc(td_mpp, tl_proc)
+
+               ! clean
+               CALL att_clean(tl_att)
+               CALL file_clean(tl_proc)
+
+               ! update proc number
+               jk=jk+1 !ji+(jj-1)*td_lay%i_niproc
+
+            ENDIF
          ENDDO
       ENDDO
 
-      DO jj=2,td_mpp%i_njproc
-         DO ji=1,td_mpp%i_niproc
-            il_jmpp(ji,jj)=il_jmpp(ji,jj-1)+il_nlcj(ji,jj-1)-2*td_mpp%i_precj
-         ENDDO
-      ENDDO 
-
-      DO jj=1,td_mpp%i_njproc
-         DO ji=1,td_mpp%i_niproc
-
-            jk=ji+(jj-1)*td_mpp%i_niproc
-
-            ! get processor file name
-            cl_file=file_rename(td_mpp%c_name,jk)
-            ! initialise file structure
-            tl_proc=file_init(cl_file,td_mpp%c_type)
-
-            ! procesor id
-            tl_proc%i_pid=jk
-
-            tl_att=att_init("DOMAIN_number",tl_proc%i_pid)
-            CALL file_add_att(tl_proc, tl_att)
-
-            ! processor indices
-            tl_proc%i_iind=ji
-            tl_proc%i_jind=jj
-
-            ! fill processor dimension and first indices
-            tl_proc%i_impp = il_impp(ji,jj)
-            tl_proc%i_jmpp = il_jmpp(ji,jj)
-
-            tl_att=att_init( "DOMAIN_poistion_first", &
-            &                (/tl_proc%i_impp, tl_proc%i_jmpp/) )
-            CALL file_add_att(tl_proc, tl_att)
-
-            tl_proc%i_lci  = il_nlci(ji,jj)
-            tl_proc%i_lcj  = il_nlcj(ji,jj)
-
-            tl_att=att_init( "DOMAIN_poistion_last", &
-            &                (/tl_proc%i_lci, tl_proc%i_lcj/) )
-            CALL file_add_att(tl_proc, tl_att)
-
-            ! compute first and last indoor indices
-            
-            ! west boundary
-            IF( ji == 1 )THEN
-               tl_proc%i_ldi = 1 
-               tl_proc%l_ctr = .TRUE.
-            ELSE
-               tl_proc%i_ldi = 1 + td_mpp%i_preci
-            ENDIF
-
-            ! south boundary
-            IF( jj == 1 )THEN
-               tl_proc%i_ldj = 1 
-               tl_proc%l_ctr = .TRUE.
-            ELSE
-               tl_proc%i_ldj = 1 + td_mpp%i_precj
-            ENDIF
-
-            ! east boundary
-            IF( ji == td_mpp%i_niproc )THEN
-               tl_proc%i_lei = il_nlci(ji,jj)
-               tl_proc%l_ctr = .TRUE.
-            ELSE
-               tl_proc%i_lei = il_nlci(ji,jj) - td_mpp%i_preci
-            ENDIF
-
-            ! north boundary
-            IF( jj == td_mpp%i_njproc )THEN
-               tl_proc%i_lej = il_nlcj(ji,jj)
-               tl_proc%l_ctr = .TRUE.
-            ELSE
-               tl_proc%i_lej = il_nlcj(ji,jj) - td_mpp%i_precj
-            ENDIF
-
-            tl_att=att_init( "DOMAIN_halo_size_start", &
-            &                (/tl_proc%i_ldi, tl_proc%i_ldj/) )
-            CALL file_add_att(tl_proc, tl_att)
-            tl_att=att_init( "DOMAIN_halo_size_end", &
-            &                (/tl_proc%i_ldi, tl_proc%i_ldj/) )
-            CALL file_add_att(tl_proc, tl_att)
-
-            ! add processor to mpp structure
-            CALL mpp__add_proc(td_mpp, tl_proc)
-
-            ! clean
-            CALL att_clean(tl_att)
-            CALL file_clean(tl_proc)
-
-         ENDDO
-      ENDDO
-
-      DEALLOCATE( il_impp, il_jmpp )
-      DEALLOCATE( il_nlci, il_nlcj )
-
-   END SUBROUTINE mpp__compute
+   END SUBROUTINE mpp__create_layout
    !-------------------------------------------------------------------
    !> @brief 
-   !>  This subroutine remove land processor from domain decomposition.
-   !>
+   !>  This subroutine optimize the number of sub domain to be used, given mask.
+   !> @details
+   !>  Actually it get the domain decomposition with the most land 
+   !>  processors removed.
+   !>  If no land processor could be removed, it get the decomposition with the
+   !>  most sea processors.
+   !
    !> @author J.Paul
    !> @date November, 2013 - Initial version
-   !>
+   !> @date October, 2015
+   !> - improve way to compute domain layout 
+   !> @date February, 2016
+   !> - new criteria for domain layout in case no land proc
+   !
    !> @param[inout] td_mpp mpp strcuture
-   !> @param[in] id_mask   sub domain mask (sea=1, land=0)
-   !-------------------------------------------------------------------
-   SUBROUTINE mpp__del_land( td_mpp, id_mask )
+   !> @param[in] id_mask   sub domain mask (sea=1, land=0) 
+   !> @pram[in] id_nproc maximum number of processor to be used
+   !-------------------------------------------------------------------
+   SUBROUTINE mpp__optimiz( td_mpp, id_mask, id_nproc )
       IMPLICIT NONE
       ! Argument
       TYPE(TMPP),                  INTENT(INOUT) :: td_mpp
       INTEGER(i4), DIMENSION(:,:), INTENT(IN)    :: id_mask
-
-      ! loop indices
-      INTEGER(i4) :: jk
-      !----------------------------------------------------------------
-
-      IF( ASSOCIATED(td_mpp%t_proc) )THEN
-         jk=1
-         DO WHILE( jk <= td_mpp%i_nproc )
-            IF( mpp__land_proc(td_mpp, jk, id_mask(:,:)) )THEN
-               CALL mpp__del_proc(td_mpp, jk)
-            ELSE
-               jk=jk+1
-            ENDIF
-         ENDDO
-      ELSE
-         CALL logger_error("MPP DEL LAND: domain decomposition not define.")
-      ENDIF
-
-   END SUBROUTINE mpp__del_land
-   !-------------------------------------------------------------------
-   !> @brief 
-   !>  This subroutine optimize the number of sub domain to be used, given mask.
-   !> @details
-   !>  Actually it get the domain decomposition with the most land 
-   !>  processor removed.
-   !
-   !> @author J.Paul
-   !> @date November, 2013 - Initial version
-   !
-   !> @param[inout] td_mpp mpp strcuture
-   !> @param[in] id_mask   sub domain mask (sea=1, land=0) 
-   !-------------------------------------------------------------------
-   SUBROUTINE mpp__optimiz( td_mpp, id_mask )
-      IMPLICIT NONE
-      ! Argument
-      TYPE(TMPP),                  INTENT(INOUT) :: td_mpp
-      INTEGER(i4), DIMENSION(:,:), INTENT(IN)    :: id_mask
+      INTEGER(i4)                , INTENT(IN)    :: id_nproc
 
       ! local variable
-      TYPE(TMPP)  :: tl_mpp
-      INTEGER(i4) :: il_maxproc
-
-      TYPE(TFILE), DIMENSION(:), ALLOCATABLE :: tl_proc
+      TYPE(TLAY) :: tl_lay
+      TYPE(TLAY) :: tl_sav
+
+      REAL(dp)   :: dl_min
+      REAL(dp)   :: dl_max
+      REAL(dp)   :: dl_ratio
+      REAL(dp)   :: dl_sav
+
       ! loop indices
       INTEGER(i4) :: ji
@@ -2838,124 +3061,68 @@
 
       CALL logger_trace("MPP OPTIMIZ: look for best domain decomposition")
-      tl_mpp=mpp_copy(td_mpp)
-
-      ! save maximum number of processor to be used
-      il_maxproc=td_mpp%i_nproc
+      dl_sav=0
       ! 
-      td_mpp%i_nproc=0
-      DO ji=1,il_maxproc
-         DO jj=1,il_maxproc
-
-            ! clean mpp processor
-            IF( ASSOCIATED(tl_mpp%t_proc) )THEN
-               CALL file_clean(tl_mpp%t_proc(:))
-               DEALLOCATE(tl_mpp%t_proc)
-            ENDIF
-
-            ! compute domain decomposition
-            tl_mpp%i_niproc=ji
-            tl_mpp%i_njproc=jj
-            
-            CALL mpp__compute( tl_mpp )
-            
-            ! remove land sub domain
-            CALL mpp__del_land( tl_mpp, id_mask )
-
-            CALL logger_info("MPP OPTIMIZ: number of processor "//&
-            &  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 
-
-               ! clean mpp
-               CALL mpp_clean(td_mpp)
-
-               ! save processor array
-               ALLOCATE( tl_proc(tl_mpp%i_nproc) )
-               tl_proc(:)=file_copy(tl_mpp%t_proc(:))
-
-               ! remove pointer on processor array
-               CALL file_clean(tl_mpp%t_proc(:))
-               DEALLOCATE(tl_mpp%t_proc)
- 
-               ! save data except processor array
-               td_mpp=mpp_copy(tl_mpp)
-
-               ! save processor array
-               ALLOCATE( td_mpp%t_proc(td_mpp%i_nproc) )
-               td_mpp%t_proc(:)=file_copy(tl_proc(:))
-
-               ! clean
-               CALL file_clean( tl_proc(:) )
-               DEALLOCATE(tl_proc)
-
-            ENDIF
-            
+      DO ji=1,id_nproc
+         DO jj=1,id_nproc
+
+            ! compute domain layout
+            tl_lay=layout__init( td_mpp, id_mask, ji,jj )
+            IF( tl_lay%i_nsea <= id_nproc )THEN
+
+               IF( ASSOCIATED(tl_sav%i_lci) )THEN
+                  IF( tl_sav%i_nland /= 0 )THEN
+                     ! look for layout with most land proc
+                     IF( tl_lay%i_nland > tl_sav%i_nland    .OR. &
+                     &   ( tl_lay%i_nland == tl_sav%i_nland .AND. &
+                     &     tl_lay%i_min   >  tl_sav%i_min   ) )THEN
+                        ! save optimiz layout
+                        CALL logger_info("MPP OPTIMIZ:save this decomposition "//&
+                        &   TRIM(fct_str(ji))//"x"//TRIM(fct_str(jj))//"="//&
+                        &   TRIM(fct_str(tl_lay%i_nsea)) )
+
+                        tl_sav=layout__copy(tl_lay)
+                     ENDIF
+                  ELSE ! tl_sav%i_nland == 0
+                     ! look for layout with most sea proc 
+                     ! and "square" cell 
+                     dl_min=MIN(tl_lay%i_lci(1,1),tl_lay%i_lcj(1,1))
+                     dl_max=MAX(tl_lay%i_lci(1,1),tl_lay%i_lcj(1,1))
+                     dl_ratio=dl_min/dl_max
+                     IF( tl_lay%i_nsea > tl_sav%i_nsea    .OR. &
+                     &   ( tl_lay%i_nsea == tl_sav%i_nsea .AND. &
+                     &     dl_ratio   >  dl_sav ) )THEN
+                        ! save optimiz layout
+                        CALL logger_info("MPP OPTIMIZ:save this decomposition "//&
+                        &   TRIM(fct_str(ji))//"x"//TRIM(fct_str(jj))//"="//&
+                        &   TRIM(fct_str(tl_lay%i_nsea)) )
+
+                        tl_sav=layout__copy(tl_lay)
+                        dl_sav=dl_ratio
+                     ENDIF
+                  ENDIF
+               ELSE
+                  ! init tl_sav
+                  tl_sav=layout__copy(tl_lay)
+
+                  dl_min=MIN(tl_sav%i_lci(1,1),tl_sav%i_lcj(1,1))
+                  dl_max=MAX(tl_sav%i_lci(1,1),tl_sav%i_lcj(1,1))
+                  dl_sav=dl_min/dl_max
+               ENDIF
+
+            ENDIF
+
+            ! clean
+            CALL layout__clean( tl_lay )
+
          ENDDO
       ENDDO
 
+      ! create mpp domain layout
+      CALL mpp__create_layout(td_mpp, tl_sav)
+
       ! clean
-      CALL mpp_clean(tl_mpp)
+      CALL layout__clean( tl_sav )
 
    END SUBROUTINE mpp__optimiz
-   !-------------------------------------------------------------------
-   !> @brief
-   !>    This function check if processor is a land processor.
-   !>
-   !> @author J.Paul
-   !> @date November, 2013 - Initial version
-   !>
-   !> @param[in] td_mpp    mpp strcuture
-   !> @param[in] id_proc   processor id
-   !> @param[in] id_mask   sub domain mask (sea=1, land=0)
-   !-------------------------------------------------------------------
-   LOGICAL FUNCTION mpp__land_proc( td_mpp , id_proc, id_mask )
-      IMPLICIT NONE
-      ! Argument
-      TYPE(TMPP),                  INTENT(IN) :: td_mpp
-      INTEGER(i4),                 INTENT(IN) :: id_proc
-      INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_mask
-
-      ! local variable
-      INTEGER(i4), DIMENSION(2) :: il_shape
-      !----------------------------------------------------------------
-
-      CALL logger_trace("MPP LAND PROC: check processor "//TRIM(fct_str(id_proc))//&
-      &  " of mpp "//TRIM(td_mpp%c_name) )
-      mpp__land_proc=.FALSE.
-      IF( ASSOCIATED(td_mpp%t_proc) )THEN
-
-         il_shape(:)=SHAPE(id_mask)
-         IF( il_shape(1) /= td_mpp%t_dim(1)%i_len .OR. &
-         &   il_shape(2) /= td_mpp%t_dim(2)%i_len )THEN
-             CALL logger_debug("MPP LAND PROC: mask size ("//&
-             &                  TRIM(fct_str(il_shape(1)))//","//&
-             &                  TRIM(fct_str(il_shape(2)))//")")
-             CALL logger_debug("MPP LAND PROC: domain size ("//&
-             &                  TRIM(fct_str(td_mpp%t_dim(1)%i_len))//","//&
-             &                  TRIM(fct_str(td_mpp%t_dim(2)%i_len))//")")
-             CALL logger_error("MPP LAND PROC: mask and domain size differ")
-         ELSE
-            IF( ALL(id_mask( td_mpp%t_proc(id_proc)%i_impp +            &
-            &                       td_mpp%t_proc(id_proc)%i_ldi - 1 : &
-            &                td_mpp%t_proc(id_proc)%i_impp +            &
-            &                       td_mpp%t_proc(id_proc)%i_lei - 1,  &
-            &                td_mpp%t_proc(id_proc)%i_jmpp +            &
-            &                       td_mpp%t_proc(id_proc)%i_ldj - 1 : &
-            &                td_mpp%t_proc(id_proc)%i_jmpp +            &
-            &                       td_mpp%t_proc(id_proc)%i_lej - 1)  &
-            &      /= 1 ) )THEN
-               ! land domain
-               CALL logger_info("MPP LAND PROC: processor "//TRIM(fct_str(id_proc))//&
-               &             " is land processor")
-               mpp__land_proc=.TRUE.
-            ENDIF
-         ENDIF
-
-      ELSE
-         CALL logger_error("MPP LAND PROC: domain decomposition not define.")
-      ENDIF
-
-   END FUNCTION mpp__land_proc
    !-------------------------------------------------------------------
    !> @brief 
@@ -3146,5 +3313,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013
+   !> @date November, 2013 - Initial version
    !>
    !> @param[inout] td_mpp mpp strcuture
@@ -3184,5 +3351,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013
+   !> @date November, 2013 - Initial version
    !>
    !> @param[in] td_mpp    mpp strcuture
@@ -3214,12 +3381,15 @@
          SELECT CASE(TRIM(td_mpp%c_dom))
             CASE('full')
-               il_i1 = 1 ; il_i2 = td_mpp%t_dim(1)%i_len
-               il_j1 = 1 ; il_j2 = td_mpp%t_dim(2)%i_len
-            CASE('overlap')
-                il_i1 = td_mpp%t_proc(id_procid)%i_impp
-                il_j1 = td_mpp%t_proc(id_procid)%i_jmpp
-
-                il_i2 = il_i1 + td_mpp%t_proc(id_procid)%i_lci - 1 
-                il_j2 = il_j1 + td_mpp%t_proc(id_procid)%i_lcj - 1 
+               il_i1 = 1 
+               il_j1 = 1 
+
+               il_i2 = td_mpp%t_dim(1)%i_len
+               il_j2 = td_mpp%t_dim(2)%i_len
+            CASE('noextra')
+               il_i1 = td_mpp%t_proc(id_procid)%i_impp
+               il_j1 = td_mpp%t_proc(id_procid)%i_jmpp
+
+               il_i2 = il_i1 + td_mpp%t_proc(id_procid)%i_lci - 1 
+               il_j2 = il_j1 + td_mpp%t_proc(id_procid)%i_lcj - 1 
             CASE('nooverlap')
                il_i1 = td_mpp%t_proc(id_procid)%i_impp + &
@@ -3233,5 +3403,6 @@
                &        td_mpp%t_proc(id_procid)%i_lej - 1
             CASE DEFAULT
-               CALL logger_error("MPP GET PROC INDEX: invalid decomposition type.")
+               CALL logger_error("MPP GET PROC INDEX: invalid "//&
+                  &              "decomposition type.")
          END SELECT
 
@@ -3249,5 +3420,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013
+   !> @date November, 2013 - Initial version
    !
    !> @param[in] td_mpp    mpp strcuture
@@ -3283,5 +3454,5 @@
                il_jsize = td_mpp%t_dim(2)%i_len
 
-            CASE('overlap')
+            CASE('noextra')
 
                 il_isize = td_mpp%t_proc(id_procid)%i_lci
@@ -3311,5 +3482,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013
+   !> @date November, 2013 - Initial version
    !>
    !> @param[inout] td_mpp mpp strcuture
@@ -3327,5 +3498,5 @@
       IF( ASSOCIATED(td_mpp%t_proc) )THEN
 
-         IF( td_mpp%i_niproc == 0 .AND. td_mpp%i_niproc == 0 )THEN
+         IF( td_mpp%i_niproc == 0 .AND. td_mpp%i_njproc == 0 )THEN
             CALL logger_info("MPP GET DOM: use indoor indices to get domain "//&
             &             "decomposition type.")
@@ -3342,5 +3513,5 @@
             &       td_mpp%t_proc(1)%i_lcj                     )     )THEN
 
-               td_mpp%c_dom='overlap'
+               td_mpp%c_dom='noextra'
 
             ELSEIF((td_mpp%t_proc(1)%t_dim(1)%i_len ==                     &
@@ -3387,5 +3558,5 @@
                td_mpp%c_dom='nooverlap'
             ELSE
-               td_mpp%c_dom='overlap'
+               td_mpp%c_dom='noextra'
             ENDIF
 
@@ -3404,5 +3575,7 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date September 2015
+   !> - do not check used dimension here
    !>
    !> @param[in] td_mpp mpp structure
@@ -3417,5 +3590,9 @@
 
       ! local variable
-      INTEGER(i4) :: il_ndim
+      CHARACTER(LEN=lc) :: cl_dim
+      LOGICAL :: ll_error
+      LOGICAL :: ll_warn
+
+      INTEGER(i4)       :: il_ind
 
       ! loop indices
@@ -3423,29 +3600,71 @@
       !----------------------------------------------------------------
       mpp__check_var_dim=.TRUE.
+
       ! check used dimension 
-      IF( ANY( td_var%t_dim(:)%l_use .AND. &
-      &        td_var%t_dim(:)%i_len /= td_mpp%t_dim(:)%i_len) )THEN
+      ll_error=.FALSE.
+      ll_warn=.FALSE.
+      DO ji=1,ip_maxdim
+         il_ind=dim_get_index( td_mpp%t_dim(:), &
+         &                     TRIM(td_var%t_dim(ji)%c_name), &
+         &                     TRIM(td_var%t_dim(ji)%c_sname))
+         IF( il_ind /= 0 )THEN
+            IF( td_var%t_dim(ji)%l_use  .AND. &
+            &   td_mpp%t_dim(il_ind)%l_use .AND. &
+            &   td_var%t_dim(ji)%i_len /= td_mpp%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
+
+         cl_dim='(/'
+         DO ji = 1, td_mpp%i_ndim
+            IF( td_mpp%t_dim(ji)%l_use )THEN
+               cl_dim=TRIM(cl_dim)//&
+               &  TRIM(fct_upper(td_mpp%t_dim(ji)%c_sname))//':'//&
+               &  TRIM(fct_str(td_mpp%t_dim(ji)%i_len))//','
+            ENDIF
+         ENDDO
+         cl_dim=TRIM(cl_dim)//'/)'
+         CALL logger_debug( " mpp dimension: "//TRIM(cl_dim) )
+
+         cl_dim='(/'
+         DO ji = 1, td_var%i_ndim
+            IF( td_var%t_dim(ji)%l_use )THEN
+               cl_dim=TRIM(cl_dim)//&
+               &  TRIM(fct_upper(td_var%t_dim(ji)%c_sname))//':'//&
+               &  TRIM(fct_str(td_var%t_dim(ji)%i_len))//','
+            ENDIF
+         ENDDO
+         cl_dim=TRIM(cl_dim)//'/)'
+         CALL logger_debug( " variable dimension: "//TRIM(cl_dim) )
 
          mpp__check_var_dim=.FALSE.
 
          CALL logger_error( &
-         &  "MPP CHECK DIM: variable and mpp dimension differ"//&
+         &  " MPP CHECK VAR DIM: variable and file 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
-            CALL logger_debug( &
-            &  "MPP CHECK DIM: for dimension "//&
-            &  TRIM(td_mpp%t_dim(ji)%c_name)//&
-            &  ", mpp length: "//&
-            &  TRIM(fct_str(td_mpp%t_dim(ji)%i_len))//&
-            &  ", variable length: "//&
-            &  TRIM(fct_str(td_var%t_dim(ji)%i_len))//&
-            &  ", variable used "//TRIM(fct_str(td_var%t_dim(ji)%l_use)))
-         ENDDO
+         &  " and file "//TRIM(td_mpp%c_name))
+
+      ELSEIF( ll_warn )THEN
+         CALL logger_warn( &
+         &  " MPP CHECK VAR DIM: variable and file dimension differ"//&
+         &  " for variable "//TRIM(td_var%c_name)//&
+         &  " and file "//TRIM(td_mpp%c_name)//". you should use"//&
+         &  " var_check_dim to remove useless dimension.")
+      ELSE
+
+         IF( td_var%i_ndim >  td_mpp%i_ndim )THEN
+            CALL logger_info("MPP CHECK VAR DIM: variable "//&
+            &  TRIM(td_var%c_name)//" use more dimension than file "//&
+            &  TRIM(td_mpp%c_name)//" do until now.")
+         ENDIF
+
       ENDIF
 
@@ -3456,5 +3675,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   array of file structure
@@ -3496,5 +3715,5 @@
    !
    !> @author J.Paul
-   !> - Ocotber, 2014- Initial Version
+   !> @date Ocotber, 2014 - Initial Version
    !
    !> @param[in] td_mpp   mpp file structure
@@ -3603,4 +3822,278 @@
       ENDIF
    END FUNCTION mpp_recombine_var
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read subdomain indices defined with halo
+   !> (NEMO netcdf way)
+   !>
+   !> @author J.Paul
+   !> @date January, 2016 - Initial Version
+   !>
+   !> @param[inout] td_file   mpp structure
+   !-------------------------------------------------------------------
+   SUBROUTINE mpp__read_halo(td_file, td_dimglo) 
+   IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE)              , INTENT(INOUT) :: td_file
+      TYPE(TDIM) , DIMENSION(:), INTENT(IN   ) :: td_dimglo
+
+      ! local variable
+      INTEGER(i4)       :: il_attid
+      INTEGER(i4)       :: il_ifirst
+      INTEGER(i4)       :: il_jfirst
+      INTEGER(i4)       :: il_ilast
+      INTEGER(i4)       :: il_jlast
+      INTEGER(i4)       :: il_ihalostart
+      INTEGER(i4)       :: il_jhalostart
+      INTEGER(i4)       :: il_ihaloend
+      INTEGER(i4)       :: il_jhaloend
+
+      CHARACTER(LEN=lc) :: cl_dom
+      !----------------------------------------------------------------
+
+      ! DOMAIN_position_first
+      il_attid = 0
+      IF( ASSOCIATED(td_file%t_att) )THEN
+         il_attid=att_get_id( td_file%t_att, "DOMAIN_position_first" )
+      ENDIF
+      IF( il_attid /= 0 )THEN
+         il_ifirst = INT(td_file%t_att(il_attid)%d_value(1))
+         il_jfirst = INT(td_file%t_att(il_attid)%d_value(2))
+      ELSE
+         il_ifirst = 1
+         il_jfirst = 1
+      ENDIF
+
+      ! DOMAIN_position_last
+      il_attid = 0
+      IF( ASSOCIATED(td_file%t_att) )THEN
+         il_attid=att_get_id( td_file%t_att, "DOMAIN_position_last" )
+      ENDIF
+      IF( il_attid /= 0 )THEN
+         il_ilast = INT(td_file%t_att(il_attid)%d_value(1))
+         il_jlast = INT(td_file%t_att(il_attid)%d_value(2))
+      ELSE
+         il_ilast = td_file%t_dim(1)%i_len
+         il_jlast = td_file%t_dim(2)%i_len
+      ENDIF
+
+      ! DOMAIN_halo_size_start
+      il_attid = 0
+      IF( ASSOCIATED(td_file%t_att) )THEN
+         il_attid=att_get_id( td_file%t_att, "DOMAIN_halo_size_start" )
+      ENDIF
+      IF( il_attid /= 0 )THEN
+         il_ihalostart = INT(td_file%t_att(il_attid)%d_value(1))
+         il_jhalostart = INT(td_file%t_att(il_attid)%d_value(2))
+      ELSE
+         il_ihalostart = 0
+         il_jhalostart = 0
+      ENDIF
+
+      ! DOMAIN_halo_size_end
+      il_attid = 0
+      IF( ASSOCIATED(td_file%t_att) )THEN
+         il_attid=att_get_id( td_file%t_att, "DOMAIN_halo_size_end" )
+      ENDIF
+      IF( il_attid /= 0 )THEN
+         il_ihaloend = INT(td_file%t_att(il_attid)%d_value(1))
+         il_jhaloend = INT(td_file%t_att(il_attid)%d_value(2))
+      ELSE
+         il_ihaloend = 0
+         il_jhaloend = 0
+      ENDIF
+
+      IF( (td_dimglo(jp_I)%i_len == td_file%t_dim(jp_I)%i_len) .AND. &
+        & (td_dimglo(jp_J)%i_len == td_file%t_dim(jp_J)%i_len) )THEN
+         cl_dom='full'
+      ELSEIF( il_ihalostart == 0 .AND. il_jhalostart == 0 .AND. &
+           &  il_ihaloend == 0 .AND. il_jhaloend == 0 )THEN
+         cl_dom='nooverlap'
+      ELSE
+         cl_dom='noextra'
+      ENDIF
+
+      SELECT CASE(TRIM(cl_dom))
+         CASE('full')
+            td_file%i_impp = il_ifirst 
+            td_file%i_jmpp = il_jfirst
+            td_file%i_lci  = td_file%t_dim(jp_I)%i_len 
+            td_file%i_lcj  = td_file%t_dim(jp_J)%i_len
+            td_file%i_ldi  = il_ihalostart + 1
+            td_file%i_ldj  = il_jhalostart + 1
+            td_file%i_lei  = td_file%t_dim(jp_I)%i_len - il_ihaloend
+            td_file%i_lej  = td_file%t_dim(jp_J)%i_len - il_jhaloend
+         CASE('noextra')
+            td_file%i_impp = il_ifirst
+            td_file%i_jmpp = il_jfirst
+            td_file%i_lci  = td_file%t_dim(jp_I)%i_len
+            td_file%i_lcj  = td_file%t_dim(jp_J)%i_len
+            td_file%i_ldi  = il_ihalostart + 1
+            td_file%i_ldj  = il_jhalostart + 1
+            td_file%i_lei  = td_file%i_lci - il_ihaloend
+            td_file%i_lej  = td_file%i_lcj - il_jhaloend
+         CASE('nooverlap') !!!?????
+            td_file%i_impp = il_ifirst
+            td_file%i_jmpp = il_jfirst
+            td_file%i_lci  = td_file%t_dim(jp_I)%i_len
+            td_file%i_lcj  = td_file%t_dim(jp_J)%i_len
+            td_file%i_ldi  = 1
+            td_file%i_ldj  = 1 
+            td_file%i_lei  = td_file%t_dim(jp_I)%i_len
+            td_file%i_lej  = td_file%t_dim(jp_J)%i_len
+      END SELECT
+
+   END SUBROUTINE mpp__read_halo
+   !-------------------------------------------------------------------
+   !> @brief This subroutine compute subdomain indices defined with halo
+   !> (NEMO netcdf way)
+   !>
+   !> @author J.Paul
+   !> @date January, 2016 - Initial Version
+   !>
+   !> @param[inout] td_mpp   mpp structure
+   !-------------------------------------------------------------------
+   SUBROUTINE mpp__compute_halo(td_mpp) 
+   IMPLICIT NONE
+      ! Argument      
+      TYPE(TMPP)      , INTENT(INOUT) :: td_mpp
+
+      ! local variable
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ifirst
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jfirst
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ilast
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jlast
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ihalostart
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jhalostart
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ihaloend
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jhaloend
+
+      TYPE(TATT)                             :: tl_att
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ALLOCATE( il_ifirst    (td_mpp%i_nproc) )
+      ALLOCATE( il_jfirst    (td_mpp%i_nproc) )
+
+      ALLOCATE( il_ilast     (td_mpp%i_nproc) )
+      ALLOCATE( il_jlast     (td_mpp%i_nproc) )
+
+      ALLOCATE( il_ihalostart(td_mpp%i_nproc) )
+      ALLOCATE( il_jhalostart(td_mpp%i_nproc) )
+
+      ALLOCATE( il_ihaloend  (td_mpp%i_nproc) )
+      ALLOCATE( il_jhaloend  (td_mpp%i_nproc) )
+
+      SELECT CASE(TRIM(td_mpp%c_dom))
+         CASE('full')
+            
+            il_ifirst(:)=td_mpp%t_proc(:)%i_impp
+            il_jfirst(:)=td_mpp%t_proc(:)%i_jmpp
+            
+            il_ilast(:)=td_mpp%t_proc(:)%i_impp + td_mpp%t_proc(:)%t_dim(jp_I)%i_len - 1
+            il_jlast(:)=td_mpp%t_proc(:)%i_jmpp + td_mpp%t_proc(:)%t_dim(jp_J)%i_len - 1
+
+            il_ihalostart(:)=td_mpp%t_proc(:)%i_ldi-1
+            il_jhalostart(:)=td_mpp%t_proc(:)%i_ldj-1
+            
+            il_ihaloend(:)=td_mpp%t_proc(:)%t_dim(jp_I)%i_len - td_mpp%t_proc(:)%i_lei
+            il_jhaloend(:)=td_mpp%t_proc(:)%t_dim(jp_J)%i_len - td_mpp%t_proc(:)%i_lej
+
+         CASE('noextra')
+            
+            il_ifirst(:)=td_mpp%t_proc(:)%i_impp
+            il_jfirst(:)=td_mpp%t_proc(:)%i_jmpp
+
+            il_ilast(:) =td_mpp%t_proc(:)%i_impp + td_mpp%t_proc(:)%i_lci - 1
+            il_jlast(:) =td_mpp%t_proc(:)%i_jmpp + td_mpp%t_proc(:)%i_lcj - 1
+            
+            il_ihalostart(:)=td_mpp%t_proc(:)%i_ldi-1
+            il_jhalostart(:)=td_mpp%t_proc(:)%i_ldj-1
+            
+            il_ihaloend(:)=td_mpp%t_proc(:)%i_lci - td_mpp%t_proc(:)%i_lei
+            il_jhaloend(:)=td_mpp%t_proc(:)%i_lcj - td_mpp%t_proc(:)%i_lej
+
+         CASE('nooverlap')
+
+            il_ifirst(:)=td_mpp%t_proc(:)%i_impp + td_mpp%t_proc(:)%i_ldi - 1
+            il_jfirst(:)=td_mpp%t_proc(:)%i_jmpp + td_mpp%t_proc(:)%i_ldj - 1
+
+            il_ilast(:)=td_mpp%t_proc(:)%i_impp + td_mpp%t_proc(:)%i_lei - 1
+            il_jlast(:)=td_mpp%t_proc(:)%i_jmpp + td_mpp%t_proc(:)%i_lej - 1
+
+            il_ihalostart(:)=0
+            il_jhalostart(:)=0
+
+            il_ihaloend(:)=0
+            il_jhaloend(:)=0
+
+         CASE DEFAULT
+            CALL logger_fatal("MPP INIT: invalid "//&
+            &              "decomposition type.")                     
+      END SELECT
+
+      DO ji=1,td_mpp%i_nproc
+         tl_att=att_init( "DOMAIN_position_first", &
+         &                (/ il_ifirst(ji), il_jfirst(ji) /) )
+         CALL file_move_att(td_mpp%t_proc(ji), tl_att)      
+
+         tl_att=att_init( "DOMAIN_position_last", &
+         &                (/ il_ilast(ji), il_jlast(ji) /) )
+         CALL file_move_att(td_mpp%t_proc(ji), tl_att)
+
+         tl_att=att_init( "DOMAIN_halo_size_start", &
+         &                (/ il_ihalostart(ji), il_jhalostart(ji) /) )
+         CALL file_move_att( td_mpp%t_proc(ji), tl_att)               
+
+         tl_att=att_init( "DOMAIN_halo_size_end", &
+         &                (/ il_ihaloend(ji), il_jhaloend(ji) /) )
+         CALL file_move_att( td_mpp%t_proc(ji), tl_att)
+      ENDDO
+
+      DEALLOCATE( il_ifirst    )
+      DEALLOCATE( il_jfirst    )
+ 
+      DEALLOCATE( il_ilast     )
+      DEALLOCATE( il_jlast     )
+ 
+      DEALLOCATE( il_ihalostart)
+      DEALLOCATE( il_jhalostart)
+
+      DEALLOCATE( il_ihaloend  )
+      DEALLOCATE( il_jhaloend  )
+
+      !impp
+      tl_att=att_init( "SUBDOMAIN_I_left_bottom_indices", td_mpp%t_proc(:)%i_impp)
+      CALL mpp_move_att(td_mpp, tl_att)
+
+      tl_att=att_init( "SUBDOMAIN_J_left_bottom_indices", td_mpp%t_proc(:)%i_jmpp)
+      CALL mpp_move_att(td_mpp, tl_att)
+
+      ! lci
+      tl_att=att_init( "SUBDOMAIN_I_dimensions", td_mpp%t_proc(:)%i_lci)
+      CALL mpp_move_att(td_mpp, tl_att)
+
+      tl_att=att_init( "SUBDOMAIN_J_dimensions", td_mpp%t_proc(:)%i_lcj)
+      CALL mpp_move_att(td_mpp, tl_att)
+
+      ! ldi
+      tl_att=att_init( "SUBDOMAIN_I_first_indoor_indices", td_mpp%t_proc(:)%i_ldi)
+      CALL mpp_move_att(td_mpp, tl_att)
+
+      tl_att=att_init( "SUBDOMAIN_J_first_indoor_indices", td_mpp%t_proc(:)%i_ldj)
+      CALL mpp_move_att(td_mpp, tl_att)
+
+      ! lei
+      tl_att=att_init( "SUBDOMAIN_I_last_indoor_indices", td_mpp%t_proc(:)%i_lei)
+      CALL mpp_move_att(td_mpp, tl_att)
+
+      tl_att=att_init( "SUBDOMAIN_J_last_indoor_indices", td_mpp%t_proc(:)%i_lej)
+      CALL mpp_move_att(td_mpp, tl_att)         
+
+      ! clean
+      CALL att_clean(tl_att)
+
+   END SUBROUTINE mpp__compute_halo
 END MODULE mpp
 
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/multi.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/multi.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/multi.f90	(revision 6440)
@@ -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,9 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - check if variable to be read is in file
+   !> @date January, 2016
+   !> - read variable dimensions
    !>
    !> @param[in] cd_varfile   variable location information (from namelist) 
@@ -184,16 +189,19 @@
 
       ! local variable
-      CHARACTER(LEN=lc) :: cl_name
-      CHARACTER(LEN=lc) :: cl_lower
-      CHARACTER(LEN=lc) :: cl_file
-      CHARACTER(LEN=lc) :: cl_matrix
-
-      INTEGER(i4)       :: il_nvar
-
-      LOGICAL           :: ll_dim
-
-      TYPE(TVAR)        :: tl_var
-
-      TYPE(TMPP)        :: tl_mpp
+      CHARACTER(LEN=lc)                :: cl_name
+      CHARACTER(LEN=lc)                :: cl_lower
+      CHARACTER(LEN=lc)                :: cl_file
+      CHARACTER(LEN=lc)                :: cl_matrix
+
+      INTEGER(i4)                      :: il_nvar
+      INTEGER(i4)                      :: il_varid
+
+      LOGICAL                          :: ll_dim
+
+      TYPE(TDIM), DIMENSION(ip_maxdim) :: tl_dim
+
+      TYPE(TVAR)                       :: tl_var
+
+      TYPE(TMPP)                       :: tl_mpp
 
       ! loop indices
@@ -212,6 +220,6 @@
 
          IF( LEN(TRIM(cl_file)) == lc )THEN
-            CALL logger_fatal("MULTI INIT: file name too long (==256)."//&
-            &  " check namelist.")
+            CALL logger_fatal("MULTI INIT: file name too long (>"//&
+            &          TRIM(fct_str(lc))//"). check namelist.")
          ENDIF
 
@@ -239,12 +247,25 @@
                   ! 
                   tl_mpp=mpp_init( file_init(TRIM(cl_file)) )
-
                   ! define variable
                   IF( TRIM(fct_lower(cl_lower)) /= 'all' )THEN
 
-                     ! clean var
+                     ! 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
+
+                     ! get (global) variable dimension
+                     tl_dim(jp_I)=dim_copy(tl_mpp%t_dim(jp_I))
+                     tl_dim(jp_J)=dim_copy(tl_mpp%t_dim(jp_J))
+                     tl_dim(jp_K)=dim_copy(tl_mpp%t_proc(1)%t_var(il_varid)%t_dim(jp_K))
+                     tl_dim(jp_L)=dim_copy(tl_mpp%t_proc(1)%t_var(il_varid)%t_dim(jp_L))
+
+                     ! clean all varible
                      CALL mpp_del_var(tl_mpp)
 
-                     tl_var=var_init(TRIM(cl_lower))
+                     tl_var=var_init(TRIM(cl_lower), td_dim=tl_dim(:))
 
                      ! add variable
@@ -260,5 +281,5 @@
 
                      DO jk=tl_mpp%t_proc(1)%i_nvar,1,-1
-                        
+
                         ! check if variable is dimension
                         ll_dim=.FALSE.
@@ -317,5 +338,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_multi  multi file structure
@@ -348,5 +369,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_multi multi file structure
@@ -367,10 +388,10 @@
       ! print file
       IF( td_multi%i_nmpp /= 0 .AND. ASSOCIATED(td_multi%t_mpp) )THEN
-         WRITE(*,'(/a,i3)') 'MULTI: total number of mpp: ',&
+         WRITE(*,'(/a,i3)') 'MULTI: total number of file(s): ',&
          &  td_multi%i_nmpp
-         WRITE(*,'(6x,a,i3)') ' total number of variable: ',&
+         WRITE(*,'(6x,a,i3)') ' total number of variable(s): ',&
          &  td_multi%i_nvar
          DO ji=1,td_multi%i_nmpp
-            WRITE(*,'(3x,3a)') 'MPP FILE ',TRIM(td_multi%t_mpp(ji)%c_name),&
+            WRITE(*,'(3x,3a)') 'FILE ',TRIM(td_multi%t_mpp(ji)%c_name),&
             & ' CONTAINS'
             DO jj=1,td_multi%t_mpp(ji)%t_proc(1)%i_nvar
@@ -391,5 +412,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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/phycst.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/phycst.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/phycst.f90	(revision 6440)
@@ -12,4 +12,6 @@
 ! REVISION HISTORY:
 !> @date November, 2013 - Initial Version
+!> @date September, 2015
+!> - add physical constant to compute meshmask
 !
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -23,14 +25,30 @@
    PUBLIC :: dp_pi      !< pi
    PUBLIC :: dp_eps     !< epsilon value
-   PUBLIC :: dp_rearth  !< earth radius (km)
+   PUBLIC :: dp_rearth  !< earth radius [m]
    PUBLIC :: dp_deg2rad !< degree to radian ratio 
+   PUBLIC :: dp_rad2deg !< radian to degree ratio 
    PUBLIC :: dp_delta   !<  
+   PUBLIC :: dp_omega   !< earth rotation parameter [s-1] 
+   PUBLIC :: dp_day     !< day                                [s]
+   PUBLIC :: dp_siyea   !< sideral year                       [s]
+   PUBLIC :: dp_siday   !< sideral day                        [s]
+
+   REAL(wp), PUBLIC ::   rday = 24.*60.*60.     !: day                                [s]
+   REAL(wp), PUBLIC ::   rsiyea                 !: sideral year                       [s]
+   REAL(wp), PUBLIC ::   rsiday                 !: sideral day                        [s]
 
    REAL(dp), PARAMETER :: dp_pi = 3.14159274101257_dp
    REAL(dp), PARAMETER :: dp_eps = EPSILON(1._dp)
-   REAL(dp), PARAMETER :: dp_rearth = 6871._dp
+   REAL(dp), PARAMETER :: dp_rearth = 6371229._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_day = 24.*60.*60.     
+   REAL(dp), PARAMETER :: dp_siyea = 365.25_wp * dp_day * &
+      &  2._wp * dp_pi / 6.283076_dp
+   REAL(dp), PARAMETER :: dp_siday = dp_day / ( 1._wp + dp_day / dp_siyea )
+
+   REAL(dp), PARAMETER :: dp_delta=1.e-6
+   REAL(dp), PARAMETER :: dp_omega= 2._dp * dp_pi / dp_siday
 END MODULE phycst
 
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/variable.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/variable.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/variable.f90	(revision 6440)
@@ -281,4 +281,10 @@
 !> @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
+!> @date Spetember, 2015
+!> - manage useless (dummy) variable
 !
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -293,4 +299,5 @@
    USE att                             ! attribute manager
    USE dim                             ! dimension manager
+   USE math                            ! mathematical function
    IMPLICIT NONE
    ! NOTE_avoid_public_variables_if_possible
@@ -300,4 +307,6 @@
 
    PUBLIC :: tg_varextra !< array of variable structure with extra information.
+
+   PRIVATE :: cm_dumvar  !< dummy variable array
 
    ! function and subroutine
@@ -318,4 +327,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
@@ -328,4 +338,6 @@
    PUBLIC :: var_chg_extra     !< read variable namelist information, and modify extra information.
    PUBLIC :: var_check_dim     !< check variable dimension expected
+   PUBLIC :: var_get_dummy     !< fill dummy variable array
+   PUBLIC :: var_is_dummy      !< check if variable is defined as dummy variable
 
    PRIVATE :: var__init          ! initialize variable structure without array of value
@@ -382,4 +394,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 +415,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 +428,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
@@ -433,4 +450,6 @@
    TYPE(TVAR), DIMENSION(:), ALLOCATABLE :: tg_varextra !< array of variable structure with extra information.
                                                         !< fill when running var_def_extra() 
+
+   CHARACTER(LEN=lc), DIMENSION(ip_maxdum), SAVE :: cm_dumvar !< dummy variable
 
    INTERFACE var_init
@@ -518,5 +537,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 +567,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 +599,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 +650,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 +679,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_var variable strucutre
@@ -695,5 +718,5 @@
    !
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !
    !> @param[inout] td_var array of variable strucutre
@@ -718,5 +741,5 @@
    !
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !
    !> @param[inout] td_var array of variable strucutre
@@ -744,5 +767,5 @@
    !
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !
    !> @param[inout] td_var array of variable strucutre
@@ -788,4 +811,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 +825,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 +832,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 +863,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 +875,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 +904,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 +968,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 +1073,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 +1094,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 +1121,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 +1153,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 +1168,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 +1198,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 +1258,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 +1308,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 +1346,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 +1361,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 +1391,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 +1439,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 +1470,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 +1524,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 +1558,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 +1573,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 +1603,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 +1686,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 +1736,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 +1770,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 +1785,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 +1815,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 +1852,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 +1891,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 +1925,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 +1940,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 +1971,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 +2020,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 +2046,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 +2080,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 +2095,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 +2126,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 +2176,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 +2202,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 +2236,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 +2251,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 +2282,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 +2333,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 +2359,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 +2393,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 +2408,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 +2439,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 +2491,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 +2517,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 +2551,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 +2566,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 +2597,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 +2645,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 +2671,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 +2703,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 +2718,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 +2749,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 +2799,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 +2825,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 +2859,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 +2874,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 +2905,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 +2956,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 +2982,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 +3016,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 +3031,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 +3062,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 +3115,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 +3141,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 +3175,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 +3190,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 +3221,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 +3269,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 +3295,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 +3329,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 +3344,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 +3375,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 +3425,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 +3451,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 +3485,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 +3500,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 +3531,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 +3582,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 +3608,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 +3642,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 +3658,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 +3689,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 +3741,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 +3767,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 +3801,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 +3816,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 +3847,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 +3896,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 +3922,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 +3956,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 +3971,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 +4002,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 +4053,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 +4079,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 +4113,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 +4128,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 +4159,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 +4210,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 +4236,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 +4270,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 +4285,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 +4316,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 +4368,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 +4394,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 +4428,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 +4443,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 +4474,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 +4522,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 +4548,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 +4582,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 +4597,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 +4628,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 +4678,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 +4704,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 +4738,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 +4753,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 +4784,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 +4835,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 +4861,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 +4895,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 +4910,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 +4941,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 +4993,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 +5011,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_var1   variable structure
@@ -4523,5 +5061,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_var1   variable structure
@@ -4595,5 +5133,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_var1   variable structure
@@ -4670,5 +5208,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_var1   variable structure
@@ -4745,5 +5283,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_var1   variable structure
@@ -4820,5 +5358,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 +5373,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 +5383,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 +5489,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 +5503,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 +5520,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 +5537,5 @@
       INTEGER(i4) :: il_ind
 
+      TYPE(TATT)  :: tl_att
       ! loop indices
       !----------------------------------------------------------------
@@ -5007,5 +5549,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 +5555,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 +5566,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 +5586,4 @@
 
       ! loop indices
-      !INTEGER(i4) :: ji
       !----------------------------------------------------------------
 
@@ -5051,5 +5596,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 +5648,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 +5653,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 +5684,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -5156,5 +5719,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -5195,5 +5758,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -5211,5 +5774,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 +5790,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 +5817,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -5272,5 +5836,5 @@
       !----------------------------------------------------------------
 
-      IF( td_var%i_ndim <= 4 )THEN
+      IF( td_var%i_ndim <= ip_maxdim )THEN
 
          CALL logger_trace( &
@@ -5317,5 +5881,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -5360,5 +5924,5 @@
    !>
    !> @author J.Paul
-   !> - June, 2014- Initial Version
+   !> @date June, 2014 - Initial Version
    !
    !> @param[in] td_var array of variables structure
@@ -5386,5 +5950,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_var    variable structure
@@ -5493,5 +6057,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_var variable structure
@@ -5631,5 +6195,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_var variable structure
@@ -5685,5 +6249,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -5761,5 +6325,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variabele structure
@@ -5837,5 +6401,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variabele structure
@@ -5913,5 +6477,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variabele structure
@@ -5987,5 +6551,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -6057,5 +6621,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_var variable structure
@@ -6080,5 +6644,5 @@
    !>
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[in] td_var       array of variable structure
@@ -6142,8 +6706,8 @@
    !> given variable name or standard name. 
    !>
-   !> @warning only variable read from file, have an id.
-   !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015
+   !> - check long name
    !
    !> @param[in] td_var       array of variable structure
@@ -6179,4 +6743,11 @@
          ELSE IF( fct_lower(td_var(ji)%c_stdname) == fct_lower(cd_name) .AND.&
          &    TRIM(fct_lower(td_var(ji)%c_stdname)) /= '' )THEN
+            
+            var_get_id=td_var(ji)%i_id
+            EXIT
+
+         ! look for variable long name
+         ELSE IF( fct_lower(td_var(ji)%c_longname) == fct_lower(cd_name) .AND.&
+         &    TRIM(fct_lower(td_var(ji)%c_longname)) /= '' )THEN
             
             var_get_id=td_var(ji)%i_id
@@ -6200,5 +6771,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_var array of variable structure
@@ -6219,6 +6790,7 @@
       IF( ASSOCIATED(td_var%d_value) )THEN
 
-         CALL logger_trace( "VAR GET MASK: create mask from variable "//&
-         &               TRIM(td_var%c_name) )
+         CALL logger_debug( "VAR GET MASK: create mask from variable "//&
+         &               TRIM(td_var%c_name)//", FillValue ="//&
+         &               TRIM(fct_str(td_var%d_fill)))
          var_get_mask(:,:,:)=1
          WHERE( td_var%d_value(:,:,:,1) == td_var%d_fill )
@@ -6239,5 +6811,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var array of variable structure
@@ -6322,5 +6894,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 +6931,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 +6939,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 +6949,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 +6993,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 +7033,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 +7039,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 +7050,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 +7067,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 +7074,5 @@
       REAL(dp)                                     :: dl_min
       REAL(dp)                                     :: dl_max
+      REAL(dp)                                     :: dl_unf
 
       TYPE(TVAR)       , DIMENSION(:), ALLOCATABLE :: tl_varextra
@@ -6508,7 +7091,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 +7102,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 +7139,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 +7191,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -6687,5 +7285,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_var variable structure
@@ -6697,8 +7295,12 @@
 
       ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+
       INTEGER(i4)       :: il_ind
+      
       TYPE(TATT)        :: tl_att
 
       ! loop indices
+      INTEGER(i4)       :: ji
       !----------------------------------------------------------------
 
@@ -6753,6 +7355,14 @@
                td_var%c_axis=TRIM(tg_varextra(il_ind)%c_axis)
                ! create attibute
-               tl_att=att_init('axis',TRIM(td_var%c_axis))
-               CALL var_move_att(td_var, tl_att)               
+               IF( TRIM(fct_upper(td_var%c_name)) == TRIM(td_var%c_axis) )THEN
+                  tl_att=att_init('axis',TRIM(td_var%c_axis))
+               ELSE
+                  cl_tmp=""
+                  DO ji=LEN(TRIM(td_var%c_axis)),1,-1
+                     cl_tmp=TRIM(cl_tmp)//" "//TRIM(td_var%c_axis(ji:ji))
+                  ENDDO
+                  tl_att=att_init('associate',TRIM(ADJUSTL(cl_tmp)))
+               ENDIF
+               CALL var_move_att(td_var, tl_att)
             ENDIF
 
@@ -6808,13 +7418,20 @@
             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
+
+         ELSE
+            CALL logger_warn("VAR GET EXTRA: no extra information on "//&
+               &  "variable "//TRIM(td_var%c_name)//". you should define it"//&
+               &  " (see variable.cfg).")
          ENDIF
 
@@ -6833,8 +7450,13 @@
    !> 
    !> @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 ="
+   !> @date Feb, 2016
+   !> - check character just after keyword
    !
    !> @param[in] cd_name      variable name
@@ -6859,4 +7481,5 @@
       ! loop indices
       INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
       !----------------------------------------------------------------
       ! init
@@ -6867,8 +7490,13 @@
       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:)))
-            EXIT
+            ! check character just after
+            jj=il_ind+LEN('min')
+            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. &
+            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN
+               cl_min=fct_split(cl_tmp,2,'=')
+               EXIT
+            ENDIF
          ENDIF
          ji=ji+1
@@ -6877,11 +7505,12 @@
 
       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 "//&
             &  TRIM(fct_str(var__get_min))//" for variable "//TRIM(cd_name) )
          ELSE
-            CALL logger_error("VAR GET MIN: invalid minimum value for "//&
-            &  "variable "//TRIM(cd_name)//". check namelist." )
+            CALL logger_error("VAR GET MIN: invalid minimum value ("//&
+               & TRIM(cl_min)//") for variable "//TRIM(cd_name)//&
+               & ". check namelist." )
          ENDIF
       ENDIF
@@ -6894,8 +7523,13 @@
    !> 
    !> @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 ="
+   !> @date Feb, 2016
+   !> - check character just after keyword
    !
    !> @param[in] cd_name      variable name
@@ -6920,4 +7554,5 @@
       ! loop indices
       INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
       !----------------------------------------------------------------
       ! init
@@ -6928,8 +7563,13 @@
       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:)))
-            EXIT
+            ! check character just after
+            jj=il_ind+LEN('max')
+            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. &
+            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN
+               cl_max=fct_split(cl_tmp,2,'=')
+               EXIT
+            ENDIF
          ENDIF
          ji=ji+1
@@ -6938,5 +7578,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 +7592,97 @@
    !> @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
+   !> @date Feb, 2016
+   !> - check character just after keyword
+   !
+   !> @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
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+      ! 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
+            ! check character just after
+            jj=il_ind+LEN('unf')
+            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. &
+            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN
+               cl_unf=fct_split(cl_tmp,2,'=')
+               EXIT
+            ENDIF
+         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 ="
+   !> @date Feb, 2016
+   !> - check character just after keyword
    !
    !> @param[in] cd_name      variable name
@@ -6982,4 +7701,5 @@
       ! local variable
       CHARACTER(LEN=lc) :: cl_tmp
+      CHARACTER(LEN=lc) :: cl_int
       CHARACTER(LEN=lc) :: cl_factor
       
@@ -7000,6 +7720,21 @@
       cl_tmp=fct_split(cd_varinfo,ji,';')
       DO WHILE( TRIM(cl_tmp) /= '' )
+         il_ind=INDEX(TRIM(cl_tmp),'int')
+         IF( il_ind /= 0 )THEN
+            ! check character just after
+            jj=il_ind+LEN('int')
+            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. &
+            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN
+               cl_int=fct_split(cl_tmp,2,'=')
+               EXIT
+            ENDIF
+         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 +7744,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 +7787,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 +7796,20 @@
    !> 
    !> @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 ="
+   !> @date Feb, 2016
+   !> - check character just after keyword
    !
    !> @param[in] cd_name      variable name
@@ -7090,4 +7828,7 @@
       ! local variable
       CHARACTER(LEN=lc) :: cl_tmp
+      CHARACTER(LEN=lc) :: cl_ext
+
+      INTEGER(i4)       :: il_ind
 
       ! loop indices
@@ -7101,6 +7842,21 @@
       cl_tmp=fct_split(cd_varinfo,ji,';')
       DO WHILE( TRIM(cl_tmp) /= '' )
+         il_ind=INDEX(TRIM(cl_tmp),'ext')
+         IF( il_ind /= 0 )THEN
+            ! check character just after
+            jj=il_ind+LEN('ext')
+            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. &
+            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN
+               cl_ext=fct_split(cl_tmp,2,'=')
+               EXIT
+            ENDIF
+         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 +7867,5 @@
             ENDIF
          ENDDO
-         IF( jj /= ip_nextrap + 1 ) EXIT
-         ji=ji+1
-         cl_tmp=fct_split(cd_varinfo,ji,';')         
-      ENDDO
+      ENDIF
 
 
@@ -7124,17 +7877,23 @@
    !> 
    !> @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 ="
+   !> @date Feb, 2016
+   !> - check character just after keyword
+   !>
    !> @param[in] cd_name      variable name
    !> @param[in] cd_varinfo   variable information read in namelist 
@@ -7151,4 +7910,5 @@
       ! local variable
       CHARACTER(LEN=lc) :: cl_tmp
+      CHARACTER(LEN=lc) :: cl_flt
       INTEGER(i4)       :: il_ind
 
@@ -7163,16 +7923,31 @@
       cl_tmp=fct_split(cd_varinfo,ji,';')
       DO WHILE( TRIM(cl_tmp) /= '' )
+         il_ind=INDEX(TRIM(cl_tmp),'flt')
+         IF( il_ind /= 0 )THEN
+            ! check character just after
+            jj=il_ind+LEN('flt')
+            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. &
+            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN
+               cl_flt=fct_split(cl_tmp,2,'=')
+               EXIT
+            ENDIF
+         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 +7958,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 +7990,69 @@
             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
+   !> @date Feb, 2016
+   !> - check character just after keyword
+   !
+   !> @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
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      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
+            ! check character just after
+            jj=il_ind+LEN('unt')
+            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. &
+            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN
+               var__get_unt=fct_split(cl_tmp,2,'=')
+               EXIT
+            ENDIF
+         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 +8061,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_var array of variable structure
@@ -7285,5 +8119,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -7321,4 +8155,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._dp)
+            CALL var_move_att(td_var, tl_att)
+
+            tl_att=att_init('add_offset',0._dp)
+            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 +8214,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var    variable structure
@@ -7414,5 +8299,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 +8325,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 +8356,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !
    !> @param[in] td_var array of variable structure 
@@ -7492,5 +8381,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2014- Initial Version
+   !> @date November, 2014 - Initial Version
    !
    !> @param[in] td_var time variable structure 
@@ -7553,4 +8442,96 @@
 
    END FUNCTION var_to_date
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill dummy variable array
+   !
+   !> @author J.Paul
+   !> @date September, 2015 - Initial Version
+   !
+   !> @param[in] cd_dummy dummy configuration file
+   !-------------------------------------------------------------------
+   SUBROUTINE var_get_dummy( cd_dummy )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_dummy
+
+      ! local variable
+      INTEGER(i4)   :: il_fileid
+      INTEGER(i4)   :: il_status
+
+      LOGICAL       :: ll_exist
+
+      ! loop indices
+      ! namelist
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumvar
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumdim
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumatt
+
+      !----------------------------------------------------------------
+      NAMELIST /namdum/ &   !< dummy namelist
+      &  cn_dumvar, &       !< variable  name
+      &  cn_dumdim, &       !< dimension name
+      &  cn_dumatt          !< attribute name
+      !----------------------------------------------------------------
+
+      ! init
+      cm_dumvar(:)=''
+
+      ! read namelist
+      INQUIRE(FILE=TRIM(cd_dummy), EXIST=ll_exist)
+      IF( ll_exist )THEN
+    
+         il_fileid=fct_getunit()
+   
+         OPEN( il_fileid, FILE=TRIM(cd_dummy), &
+         &                FORM='FORMATTED',       &
+         &                ACCESS='SEQUENTIAL',    &
+         &                STATUS='OLD',           &
+         &                ACTION='READ',          &
+         &                IOSTAT=il_status)
+         CALL fct_err(il_status)
+         IF( il_status /= 0 )THEN
+            CALL logger_fatal("DIM GET DUMMY: opening "//TRIM(cd_dummy))
+         ENDIF
+   
+         READ( il_fileid, NML = namdum )
+         cm_dumvar(:)=cn_dumvar(:)
+
+         CLOSE( il_fileid )
+
+      ENDIF
+   
+   END SUBROUTINE var_get_dummy
+   !-------------------------------------------------------------------
+   !> @brief This function check if variable is defined as dummy variable
+   !> in configuraton file
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial Version
+   !
+   !> @param[in] td_var variable structure
+   !> @return true if variable is dummy variable 
+   !-------------------------------------------------------------------
+   FUNCTION var_is_dummy(td_var)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR), INTENT(IN) :: td_var
+      
+      ! function
+      LOGICAL :: var_is_dummy
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      var_is_dummy=.FALSE.
+      DO ji=1,ip_maxdum
+         IF( fct_lower(td_var%c_name) == fct_lower(cm_dumvar(ji)) )THEN
+            var_is_dummy=.TRUE.
+            EXIT
+         ENDIF
+      ENDDO
+
+   END FUNCTION var_is_dummy
 END MODULE var
 
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/vgrid.f90
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/vgrid.f90	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/vgrid.f90	(revision 6440)
@@ -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,51 @@
 
    END SUBROUTINE vgrid_zgr_z
+   !-------------------------------------------------------------------
+   !> @brief This subroutine
+   !>
+   !> @todo add subroutine description
+   !>
+   !> @param[inout] dd_bathy
+   !> @param[in] dd_gdepw
+   !> @param[in] dd_hmin
+   !> @param[in] dd_fill
+   !-------------------------------------------------------------------
+   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
@@ -311,8 +379,9 @@
    !>         - gdept, gdepw and e3 are positives
    !>         - gdept_ps, gdepw_ps and e3_ps are positives
-   !
+   !>
    !> @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.
@@ -325,8 +394,10 @@
    !> @param[in] dd_e3zps_min
    !> @param[in] dd_e3zps_rat
+   !> @param[in] dd_fill
    !-------------------------------------------------------------------
    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 +407,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 +432,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 +452,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 +470,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
@@ -432,7 +504,7 @@
    !> ** Action  : - update mbathy: level bathymetry (in level index)
    !>              - update bathy : meter bathymetry (in meters)
-
+   !>
    !> @author G.Madec
-   !> - 03-08 Original code
+   !> @date Marsh, 2008 - Original code
    !
    !> @param[in] id_mbathy 
@@ -543,5 +615,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_bathy     Bathymetry file structure 
@@ -567,4 +639,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 +784,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/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/templates/create_bathy.nam
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/templates/create_bathy.nam	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/templates/create_bathy.nam	(revision 6440)
@@ -1,4 +1,4 @@
 &namlog
-   cn_logfile="bathy_out.log"
+   cn_logfile=
    cn_verbosity=
    in_maxerror=
@@ -6,5 +6,6 @@
 
 &namcfg
-   cn_varcfg="./cfg/variable.cfg"
+   cn_varcfg=
+   cn_dumcfg=
 /
 
@@ -16,9 +17,11 @@
 &namfin
    cn_coord1=
+   in_perio1=
+   ln_fillclosed=
 /
 
 &namvar
+   cn_varfile=
    cn_varinfo=
-   cn_varfile=
 /
 
@@ -29,4 +32,4 @@
 
 &namout
-   cn_fileout="bathy_out.nc"      
+   cn_fileout=
 /
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/templates/create_boundary.nam
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/templates/create_boundary.nam	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/templates/create_boundary.nam	(revision 6440)
@@ -1,4 +1,4 @@
 &namlog
-   cn_logfile="boundary.log"
+   cn_logfile=
    cn_verbosity=
    in_maxerror =
@@ -6,5 +6,6 @@
 
 &namcfg
-   cn_varcfg="./cfg/variable.cfg"
+   cn_varcfg=
+   cn_dumcfg=
 /
 
@@ -41,6 +42,6 @@
 
 &namvar
+   cn_varfile=
    cn_varinfo=
-   cn_varfile=
 /
 
@@ -60,8 +61,9 @@
    cn_west  = 
    ln_oneseg= 
-   in_extrap= 
 /
 
 &namout
-   cn_fileout="boundary_out.nc"      
+   cn_fileout=
+   dn_dayofs=
+   ln_extrap=
 /
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/templates/create_coord.nam
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/templates/create_coord.nam	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/templates/create_coord.nam	(revision 6440)
@@ -1,4 +1,4 @@
 &namlog
-   cn_logfile="coord_out.log"
+   cn_logfile=
    cn_verbosity=
    in_maxerror=
@@ -6,5 +6,6 @@
 
 &namcfg
-   cn_varcfg="./cfg/variable.cfg"
+   cn_varcfg=
+   cn_dumcfg=
 /
 
@@ -29,5 +30,5 @@
 
 &namout
-   cn_fileout="coord_out.nc"
+   cn_fileout=
 /
 
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/templates/create_restart.nam
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/templates/create_restart.nam	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/templates/create_restart.nam	(revision 6440)
@@ -1,10 +1,11 @@
 &namlog
-   cn_logfile="restart_out.log"
+   cn_logfile=
    cn_verbosity=
-   in_maxerror =
+   in_maxerror=
 /
 
 &namcfg
-   cn_varcfg="./cfg/variable.cfg"
+   cn_varcfg=
+   cn_dumcfg=
 /
 
@@ -12,4 +13,10 @@
    cn_coord0=
    in_perio0=
+/
+
+&namfin
+   cn_coord1=
+   cn_bathy1=
+   in_perio1=
 /
 
@@ -34,14 +41,7 @@
 /
 
-&namfin
-   cn_coord1=
-   cn_bathy1=
-   in_perio1=
-   in_extrap=
-/
-
 &namvar
+   cn_varfile=
    cn_varinfo=
-   cn_varfile=
 /
 
@@ -52,4 +52,9 @@
 
 &namout
-   cn_fileout="restart_out.nc"      
+   cn_fileout=
+   ln_extrap=
+   in_niproc=
+   in_njproc=
+   in_nproc=
+   cn_type=
 /
Index: branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/templates/merge_bathy.nam
===================================================================
--- branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/templates/merge_bathy.nam	(revision 6439)
+++ branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/templates/merge_bathy.nam	(revision 6440)
@@ -1,10 +1,11 @@
 &namlog
-   cn_logfile="merge_out.log"
+   cn_logfile=
    cn_verbosity=
-   in_maxerror =
+   in_maxerror=
 /
 
 &namcfg
-   cn_varcfg="./cfg/variable.cfg"
+   cn_varcfg=
+   cn_dumcfg=
 /
 
@@ -17,8 +18,4 @@
    cn_bathy1=
    in_perio1=
-/
-
-&namvar
-   cn_varinfo=
 /
 
@@ -41,4 +38,4 @@
 
 &namout
-   cn_fileout="merge_out.nc"      
+   cn_fileout=
 /
