Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/1_cfc1112.atm
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/1_cfc1112.atm	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/1_cfc1112.atm	(revision 8201)
@@ -0,0 +1,84 @@
+ % Atmospheric lifetimes are  44.0 for CFC-11 
+ %                       and 125.0 for CFC-12 
+ % rel=  0 
+ %        <-Northern Data-> <-Southern Data->
+ % Year    CFC-11  CFC-12    CFC-11  CFC-12 
+ %         (ppt)   (ppt)      (ppt)   (ppt)
+ 1931.50    0.00    0.00       0.00    0.00   
+ 1932.50    0.00    0.01       0.00    0.01   
+ 1933.50    0.00    0.02       0.00    0.01   
+ 1934.50    0.00    0.03       0.00    0.02   
+ 1935.50    0.00    0.04       0.00    0.03   
+ 1936.50    0.00    0.07       0.00    0.04   
+ 1937.50    0.00    0.11       0.00    0.07   
+ 1938.50    0.00    0.17       0.00    0.11   
+ 1939.50    0.01    0.25       0.00    0.17   
+ 1940.50    0.01    0.37       0.01    0.25   
+ 1941.50    0.02    0.53       0.01    0.36   
+ 1942.50    0.02    0.72       0.02    0.51   
+ 1943.50    0.03    0.94       0.02    0.69   
+ 1944.50    0.04    1.25       0.03    0.91   
+ 1945.50    0.05    1.65       0.04    1.21   
+ 1946.50    0.08    2.33       0.05    1.64   
+ 1947.50    0.14    3.42       0.08    2.33   
+ 1948.50    0.24    4.73       0.14    3.32   
+ 1949.50    0.42    6.10       0.25    4.48   
+ 1950.50    0.67    7.58       0.42    5.77   
+ 1951.50    1.02    9.23       0.66    7.19   
+ 1952.50    1.53   10.94       1.01    8.72   
+ 1953.50    2.21   12.82       1.49   10.37   
+ 1954.50    3.07   14.97       2.13   12.20   
+ 1955.50    4.11   17.40       2.93   14.25   
+ 1956.50    5.39   20.22       3.92   16.59   
+ 1957.50    6.84   23.45       5.11   19.28   
+ 1958.50    8.19   26.86       6.39   22.28   
+ 1959.50    9.47   30.58       7.63   25.52   
+ 1960.50   11.13   35.03       8.96   29.18   
+ 1961.50   13.38   40.12      10.63   33.42   
+ 1962.50   16.23   45.89      12.78   38.25   
+ 1963.50   19.72   52.66      15.47   43.80   
+ 1964.50   23.87   60.57      18.75   50.28   
+ 1965.50   28.57   69.53      22.61   57.76   
+ 1966.50   33.78   79.46      26.99   66.21   
+ 1967.50   39.63   90.60      31.91   75.67   
+ 1968.50   46.27  103.16      37.46   86.31   
+ 1969.50   53.96  117.17      43.80   98.25   
+ 1970.50   62.75  132.52      51.07  111.52   
+ 1971.50   72.36  149.00      59.27  126.02   
+ 1972.50   83.04  166.85      68.34  141.70   
+ 1973.50   95.27  186.59      78.54  158.82   
+ 1974.50  108.81  208.14      90.04  177.62   
+ 1975.50  121.86  229.37     102.29  197.54   
+ 1976.50  134.47  249.51     114.40  217.31   
+ 1977.50  146.47  268.67     126.28  236.49   
+ 1978.50  157.18  286.35     137.45  254.72   
+ 1979.50  166.67  303.74     147.60  272.00   
+ 1980.50  175.11  320.96     158.08  290.34   
+ 1981.50  182.81  337.33     166.54  306.90   
+ 1982.50  189.88  352.01     174.69  323.74   
+ 1983.50  197.72  367.69     183.03  341.15   
+ 1984.50  206.34  383.86     190.95  357.80   
+ 1985.50  216.12  401.25     200.50  376.45   
+ 1986.50  227.48  420.96     209.82  394.00   
+ 1987.50  239.67  441.49     220.60  412.82   
+ 1988.50  251.05  463.22     231.46  433.46   
+ 1989.50  257.28  481.80     240.38  452.97   
+ 1990.50  263.65  493.96     249.23  470.55   
+ 1991.50  266.33  504.64     254.53  484.07   
+ 1992.50  266.00  512.87     258.80  495.65   
+ 1993.50  267.58  520.12     260.56  504.49   
+ 1994.50  267.24  526.58     261.73  512.31   
+ 1995.50  266.38  531.59     261.29  518.39   
+ 1996.50  265.25  534.81     261.08  523.50   
+ 1997.50  263.84  537.67     260.16  528.18   
+ 1998.50  262.24  999.99     258.96  999.99   
+ 1999.50  260.72  999.99     257.75  999.99   
+ 2000.50  259.34  999.99     255.69  999.99   
+ 2001.50  257.13  999.99     253.54  999.99   
+ 2002.50  254.89  999.99     252.93  999.99   
+ 2003.50  251.89  999.99     250.62  999.99   
+ 2004.50  250.67  999.99     249.52  999.99   
+ 2005.50  249.49  999.99     247.45  999.99   
+ 2006.50  248.31  999.99     245.38  999.99
+ 2007.50  247.13  999.99     243.31  999.99
+ 2008.50  245.95  999.99     241.24  999.99
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/XIOS2/field_def_bgc.xml
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/XIOS2/field_def_bgc.xml	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/XIOS2/field_def_bgc.xml	(revision 8201)
@@ -0,0 +1,809 @@
+<!--
+<?xml version="1.0"?>
+       -->
+ 
+    <!-- $id$ -->
+    
+    <!-- 
+============================================================================================================
+=                                  definition of all existing variables                                    =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+   <field_definition level="1" prec="8" operation="average" enabled=".TRUE." default_value="1.e20" > <!-- time step automaticaly defined -->
+
+    <!-- 
+============================================================================================================
+                                     Biogeochemistry model variables
+============================================================================================================
+    -->
+
+      <!-- ptrc on T grid -->
+
+     <field_group id="ptrc_T" grid_ref="grid_T_3D">
+       <field id="DIC"          long_name="Dissolved inorganic Concentration"        unit="mmol/m3" />
+       <field id="DIC_E3T"      long_name="DIC * E3T"                                unit="mmol/m2" > DIC * e3t </field >
+       <field id="Alkalini"     long_name="Total Alkalinity Concentration"           unit="mmol/m3" />
+       <field id="Alkalini_E3T" long_name="Alkalini * E3T"                           unit="mmol/m2"  > Alkalini * e3t </field >
+       <field id="O2"           long_name="Oxygen Concentration"                     unit="mmol/m3" />
+       <field id="O2_E3T"       long_name="O2 * E3T"                                 unit="mmol/m2"  > O2 * e3t </field >
+       <field id="CaCO3"        long_name="Calcite Concentration"                    unit="mmol/m3" />
+       <field id="CaCO3_E3T"    long_name="CaCO3 * E3T"                              unit="mmol/m2"  > CaCO3 * e3t </field >
+       <field id="PO4"          long_name="Phosphate Concentration"                  unit="mmol/m3" />
+       <field id="PO4_E3T"      long_name="PO4 * E3T"                                unit="mmol/m2"  > PO4 * e3t </field >
+       <field id="POC"          long_name="Small organic carbon Concentration"       unit="mmol/m3" />
+       <field id="POC_E3T"      long_name="POC * E3T"                                unit="mmol/m2"  > POC * e3t </field >
+       <field id="Si"           long_name="Silicate Concentration"                   unit="mmol/m3" />
+       <field id="Si_E3T"       long_name="Si * E3T"                                 unit="mmol/m2"  > Si * e3t </field >
+       <field id="PHY"          long_name="(Nano)Phytoplankton Concentration"        unit="mmol/m3" />
+       <field id="PHY_E3T"      long_name="PHY * E3T"                                unit="mmol/m2"  > PHY * e3t </field >
+       <field id="ZOO"          long_name="(Micro)Zooplankton Concentration"         unit="mmol/m3" />
+       <field id="ZOO_E3T"      long_name="ZOO2 * E3T"                               unit="mmol/m2"  > ZOO * e3t </field >
+       <field id="DOC"          long_name="Dissolved organic Concentration"          unit="mmol/m3" />
+       <field id="DOC_E3T"      long_name="DOC * E3T"                                unit="mmol/m2"  > DOC * e3t </field >
+       <field id="PHY2"         long_name="Diatoms Concentration"                    unit="mmol/m3" />
+       <field id="PHY2_E3T"     long_name="PHY2 * E3T"                               unit="mmol/m2"  > PHY2 * e3t </field >
+       <field id="ZOO2"         long_name="Mesozooplankton Concentration"            unit="mmol/m3" />
+       <field id="ZOO2_E3T"     long_name="ZOO2 * E3T"                               unit="mmol/m2"  > ZOO2 * e3t </field >
+       <field id="DSi"          long_name="Diatoms Silicate Concentration"           unit="mmol/m3" />
+       <field id="DSi_E3T"      long_name="Dsi * E3T"                                unit="mmol/m2"  > DSi * e3t </field >
+       <field id="Fer"          long_name="Dissolved Iron Concentration"             unit="mmol/m3" />
+       <field id="Fer_E3T"      long_name="Fer * E3T"                                unit="mmol/m2"  > Fer * e3t </field >
+       <field id="BFe"          long_name="Big iron particles Concentration"         unit="mmol/m3" />
+       <field id="BFe_E3T"      long_name="BFe * E3T"                                unit="mmol/m2"  > BFe * e3t </field >
+       <field id="GOC"          long_name="Big organic carbon Concentration"         unit="mmol/m3" />
+       <field id="GOC_E3T"      long_name="GOC * E3T"                                unit="mmol/m2"  > GOC * e3t </field >
+       <field id="SFe"          long_name="Small iron particles Concentration"       unit="mmol/m3" />
+       <field id="SFe_E3T"      long_name="SFe * E3T"                                unit="mmol/m2"  > SFe * e3t </field >
+       <field id="DFe"          long_name="Diatoms iron  Concentration"              unit="mmol/m3" />
+       <field id="DFe_E3T"      long_name="DFe * E3T"                                unit="mmol/m2"  > DFe * e3t </field >
+       <field id="GSi"          long_name="Sinking biogenic Silicate Concentration"  unit="mmol/m3" />
+       <field id="GSi_E3T"      long_name="GSi * E3T"                                unit="mmol/m2"  > GSi * e3t </field >
+       <field id="NFe"          long_name="Nano iron Concentration"                  unit="mmol/m3" />
+       <field id="NFe_E3T"      long_name="NFe * E3T"                                unit="mmol/m2"  > NFe * e3t </field >
+       <field id="NCHL"         long_name="Nano chlorophyl Concentration"            unit="mg/m3"   />
+       <field id="NCHL_E3T"     long_name="NCHL * E3T"                               unit="mmol/m2"  > NCHL * e3t </field >
+       <field id="DCHL"         long_name="Diatoms chlorophyl Concentration"         unit="mg/m3"   />
+       <field id="DCHL_E3T"     long_name="DCHL * E3T"                               unit="mmol/m2"  > DCHL * e3t </field >
+       <field id="NO3"          long_name="Nitrate Concentration"                    unit="mmol/m3" />
+       <field id="NO3_E3T"      long_name="NO3 * E3T"                                unit="mmol/m2"  > NO3 * e3t </field >
+       <field id="NH4"          long_name="Ammonium Concentration"                   unit="mmol/m3" />
+       <field id="NH4_E3T"      long_name="NH4 * E3T"                                unit="mmol/m2"  > NH4 * e3t </field >
+
+      <!-- MEDUSA : variables available with key_medusa -->
+       <field id="CHN"      long_name="Chl-a concentration in non-diatom phytoplankton"   unit="mg Chl/m3" />
+       <field id="CHD"      long_name="Chl-a concentration in     diatom phytoplankton"   unit="mg Chl/m3" />
+       <field id="PHN"      long_name="non-diatom phytoplankton"                          unit="mmol-N/m3" />
+       <field id="PHD"      long_name="diatom     phytoplankton"                          unit="mmol-N/m3" />
+       <field id="ZMI"      long_name="micro zooplankton"                                 unit="mmol-N/m3" />
+       <field id="ZME"      long_name="meso  zooplankton"                                 unit="mmol-N/m3" />
+       <field id="DIN"      long_name="dissolved inorganic nitrogen"                      unit="mmol-N/m3" />
+       <field id="SIL"      long_name="dissolved silicic acid"                            unit="mmolSi/m3" />
+       <field id="FER"      long_name="dissolved iron"                                    unit="mmolFe/m3" />
+       <field id="DET"      long_name="detrital nitrogen"                                 unit="mmol-N/m3" />
+       <field id="PDS"      long_name="biogenic silicon in diatom phytoplankton"          unit="mmolSi/m3" />
+       <field id="DTC"      long_name="detrital carbon"                                   unit="mmol-C/m3" />
+       <field id="DiC"      long_name="dissolved inorganic carbon"                        unit="mmol-C/m3" />
+       <field id="ALK"      long_name="alkalinity"                                        unit="meq/m3"    />
+       <field id="OXY"      long_name="dissolved oxygen"                                  unit="mmolO2/m3" />
+
+      <!-- Ideal traceurs : variables available with key_idtra -->
+       <field id="IDTRA"    long_name="Ideal traceur concentration "                      unit="mmol/m3"    />
+
+       <!-- PISCES with Kriest parametisation : variables available with key_kriest -->
+       <field id="Num"         long_name="Number of organic particles"              unit="1" />
+       <field id="Num_E3T"     long_name="Num * E3T"                                unit="m"  > Num * e3t </field >
+
+       <!-- PISCES light : variables available with key_pisces_reduced -->
+       <field id="DET"         long_name="Detritus"                                 unit="mmol-N/m3" />
+       <field id="DET_E3T"     long_name="DET * E3T"                                unit="mmol-N/m2"  > DET * e3t </field >
+       <field id="DOM"         long_name="Dissolved Organic Matter"                 unit="mmol-N/m3" />
+       <field id="DOM_E3T"     long_name="DOM * E3T"                                unit="mmol-N/m2"  > DOM * e3t </field >
+
+       <!-- CFC11 : variables available with key_cfc -->
+       <field id="CFC11"       long_name="CFC-11 Concentration"                     unit="umol/m3" />
+       <field id="CFC11_E3T"   long_name="CFC11 * E3T"                              unit="umol/m2"  > CFC11 * e3t </field >
+       <!-- Bomb C14 : variables available with key_c14b -->
+       <field id="C14B"        long_name="Bomb C14 Concentration"                   unit="1"         />
+       <field id="C14B_E3T"    long_name="C14B * E3T"                               unit="m"  > C14B * e3t </field >
+       <!-- AGE : variables available with key_age -->
+       <field id="Age"        long_name="Sea Water Age Since Surface contact" standard_name="sea_water_age_since_surface_contact"  unit="yr"         />
+       <field id="Age_e3t"    long_name="Age * e3t"                                 unit="yr * m"  > Age * e3t </field >
+     </field_group>
+
+     <!-- PISCES additional diagnostics on T grid  -->
+
+     <field_group id="diad_T" grid_ref="grid_T_2D">
+       <field id="PH"          long_name="PH"                                      unit="1"          grid_ref="grid_T_3D" />
+       <field id="CO3"         long_name="Bicarbonates"                            unit="mol/m3"     grid_ref="grid_T_3D" />
+       <field id="CO3sat"      long_name="CO3 saturation"                          unit="mol/m3"     grid_ref="grid_T_3D" />
+       <field id="PAR"         long_name="Photosynthetically Available Radiation"  unit="W/m2"       grid_ref="grid_T_3D" />
+       <field id="PARDM"       long_name="Daily mean PAR"                          unit="W/m2"       grid_ref="grid_T_3D" />
+       <field id="PPPHY"       long_name="Primary production of nanophyto"         unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="PPPHY2"      long_name="Primary production of diatoms"           unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="PPNEWN"      long_name="New Primary production of nanophyto"     unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="PPNEWD"      long_name="New Primary production of diatoms"       unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="PBSi"        long_name="Primary production of Si diatoms"        unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="PFeN"        long_name="Primary production of nano iron"         unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="PFeD"        long_name="Primary production of diatoms iron"      unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="xfracal"     long_name="Calcifying fraction"                     unit="1"          grid_ref="grid_T_3D" />
+       <field id="PCAL"        long_name="Calcite production"                      unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="DCAL"        long_name="Calcite dissolution"                     unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="GRAZ1"       long_name="Grazing by microzooplankton"             unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="GRAZ2"       long_name="Grazing by mesozooplankton"              unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="REMIN"       long_name="Oxic remineralization of OM"             unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="DENIT"       long_name="Anoxic remineralization of OM"           unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="Nfix"        long_name="Nitrogen fixation"                       unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="Mumax"       long_name="Maximum growth rate"                     unit="s-1"        grid_ref="grid_T_3D" />
+       <field id="MuN"         long_name="Realized growth rate for nanophyto"      unit="s-1"        grid_ref="grid_T_3D" />
+       <field id="MuD"         long_name="Realized growth rate for diatomes"       unit="s-1"        grid_ref="grid_T_3D" />
+       <field id="LNnut"       long_name="Nutrient limitation term in Nanophyto"   unit=""           grid_ref="grid_T_3D" />
+       <field id="LDnut"       long_name="Nutrient limitation term in Diatoms"     unit=""           grid_ref="grid_T_3D" />
+       <field id="LNFe"        long_name="Iron limitation term in Nanophyto"       unit=""           grid_ref="grid_T_3D" />
+       <field id="LDFe"        long_name="Iron limitation term in Diatoms"         unit=""           grid_ref="grid_T_3D" />
+       <field id="LNlight"     long_name="Light limitation term in Nanophyto"      unit=""           grid_ref="grid_T_3D" />
+       <field id="LDlight"     long_name="Light limitation term in Diatoms"        unit=""           grid_ref="grid_T_3D" />
+       <field id="Fe2"         long_name="Iron II concentration"                   unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="Fe3"         long_name="Iron III concentration"                  unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="FeL1"        long_name="Complexed Iron concentration with L1"    unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="FeL2"        long_name="Complexed Iron concentration with L2"    unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="FeP"         long_name="Precipitated Iron III"                   unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="TL1"         long_name="Total L1 concentration"                  unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="TL2"         long_name="Total L2 concentration"                  unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="pdust"       long_name="dust concentration"                      unit="g/m3"                            />
+       <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="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" />
+       <field id="EPC100"      long_name="Export of carbon particles at 100 m"     unit="mol/m2/s"                        />
+       <field id="EPFE100"     long_name="Export of biogenic iron at 100 m"        unit="mol/m2/s"                        />
+       <field id="EPSI100"     long_name="Export of Silicate at 100 m"             unit="mol/m2/s"                        />
+       <field id="EPCAL100"    long_name="Export of Calcite at 100 m"              unit="mol/m2/s"                        />
+       <field id="EXPC"        long_name="Export of carbon"                        unit="mol/m2/s"   grid_ref="grid_T_3D" />
+       <field id="EXPFE"       long_name="Export of biogenic iron"                 unit="mol/m2/s"   grid_ref="grid_T_3D" />
+       <field id="EXPSI"       long_name="Export of Silicate"                      unit="mol/m2/s"   grid_ref="grid_T_3D" />
+       <field id="EXPCAL"      long_name="Export of Calcite"                       unit="mol/m2/s"   grid_ref="grid_T_3D" />
+       <field id="Cflx"        long_name="DIC flux"                                unit="mol/m2/s"                        />
+       <field id="Oflx"        long_name="Oxygen flux"                             unit="mol/m2/s"                        />
+       <field id="Kg"          long_name="Gas transfer"                            unit="mol/m2/s/uatm"                   />
+       <field id="Dpco2"       long_name="Delta CO2"                               unit="uatm"                            />
+       <field id="Dpo2"        long_name="Delta O2"                                unit="uatm"                            />
+       <field id="Heup"        long_name="Euphotic layer depth"                    unit="m"                               />
+       <field id="Irondep"     long_name="Iron deposition from dust"               unit="mol/m2/s"                        />
+       <field id="Ironsed"     long_name="Iron deposition from sediment"           unit="mol/m2/s"   grid_ref="grid_T_3D" />
+
+
+       <!-- PISCES with Kriest parametisation : variables available with key_kriest -->
+       <field id="EPN100"      long_name="Particulate number flux at 100 m"        unit="mol/m2/s"                        />
+       <field id="EXPN"        long_name="Particulate number flux"                 unit="mol/m2/s"   grid_ref="grid_T_3D" />
+       <field id="XNUM"        long_name="Number of particles in aggregats"        unit="1"          grid_ref="grid_T_3D" />
+       <field id="WSC"         long_name="sinking speed of mass flux"              unit="m2/s"       grid_ref="grid_T_3D" />
+       <field id="WSN"         long_name="sinking speed of number flux"            unit="m2/s"       grid_ref="grid_T_3D" />
+
+       <!-- dbio_T on T grid : variables available with key_diaar5 -->
+       <field id="TPP"         long_name="Total Primary production of phyto"                   unit="mol/m3/s"  grid_ref="grid_T_3D" />
+       <field id="TPNEW"       long_name="New Primary production of phyto"                     unit="mol/m3/s"  grid_ref="grid_T_3D" />
+       <field id="TPBFE"       long_name="Total biogenic iron production"                      unit="mol/m3/s"  grid_ref="grid_T_3D" />
+       <field id="INTDIC"      long_name="DIC content"                                         unit="kg/m2"                          />
+       <field id="O2MIN"       long_name="Oxygen minimum concentration"                        unit="mol/m3"                          />
+       <field id="ZO2MIN"      long_name="Depth of oxygen minimum concentration"               unit="m"                              />
+       <field id="INTNFIX"     long_name="Nitrogen fixation rate : vert. integrated"           unit="mol/m2/s"                       />
+       <field id="INTPPPHY"    long_name="Vertically integrated primary production by nanophy" unit="mol/m2/s"                       />
+       <field id="INTPPPHY2"   long_name="Vertically integrated primary production by diatom"  unit="mol/m2/s"                       />
+       <field id="INTPP"       long_name="Vertically integrated primary production by phyto"   unit="mol/m2/s"                       />
+       <field id="INTPNEW"     long_name="Vertically integrated new primary production"        unit="mol/m2/s"                       />
+       <field id="INTPBFE"     long_name="Vertically integrated of biogenic iron production"   unit="mol/m2/s"                       />
+       <field id="INTPBSI"     long_name="Vertically integrated of biogenic Si production"     unit="mol/m2/s"                       />
+       <field id="INTPCAL"     long_name="Vertically integrated of calcite production"         unit="mol/m2/s"                       />
+
+       <!-- PISCES light : variables available with key_pisces_reduced -->
+       <field id="FNO3PHY"     long_name="FNO3PHY"                                 unit=""          grid_ref="grid_T_3D" /> 
+       <field id="FNH4PHY"     long_name="FNH4PHY"                                 unit=""          grid_ref="grid_T_3D" /> 
+       <field id="FNH4NO3"     long_name="FNH4NO3"                                 unit=""          grid_ref="grid_T_3D" /> 
+       <field id="TNO3PHY"     long_name="TNO3PHY"                                 unit=""  /> 
+       <field id="TNH4PHY"     long_name="TNH4PHY"                                 unit=""  /> 
+       <field id="TPHYDOM"     long_name="TPHYDOM"                                 unit=""  /> 
+       <field id="TPHYNH4"     long_name="TPHYNH4"                                 unit=""  /> 
+       <field id="TPHYZOO"     long_name="TPHYZOO"                                 unit=""  /> 
+       <field id="TPHYDET"     long_name="TPHYDET"                                 unit=""  /> 
+       <field id="TDETZOO"     long_name="TDETZOO"                                 unit=""  /> 
+       <field id="TZOODET"     long_name="TZOODET"                                 unit=""  /> 
+       <field id="TZOOBOD"     long_name="TZOOBOD"                                 unit=""  /> 
+       <field id="TZOONH4"     long_name="TZOONH4"                                 unit=""  /> 
+       <field id="TZOODOM"     long_name="TZOODOM"                                 unit=""  /> 
+       <field id="TNH4NO3"     long_name="TNH4NO3"                                 unit=""  /> 
+       <field id="TDOMNH4"     long_name="TDOMNH4"                                 unit=""  /> 
+       <field id="TDETNH4"     long_name="TDETNH4"                                 unit=""  /> 
+       <field id="TPHYTOT"     long_name="TPHYTOT"                                 unit=""  /> 
+       <field id="TZOOTOT"     long_name="TZOOTOT"                                 unit=""  /> 
+       <field id="SEDPOC"      long_name="SEDPOC"                                  unit=""  /> 
+       <field id="TDETSED"     long_name="TDETSED"                                 unit=""  /> 
+
+       <!-- CFC11 : variables available with key_cfc -->
+       <field id="qtrCFC11"    long_name="Air-sea flux of CFC-11"                  unit="mol/m2/s"   />
+       <field id="qintCFC11"   long_name="Cumulative air-sea flux of CFC-11"       unit="mol/m2"     />
+
+       <!-- Bomb C14 : variables available with key_c14b -->
+       <field id="qtrC14b"     long_name="Air-sea flux of Bomb C14"                unit="mol/m2/s"   />
+       <field id="qintC14b"    long_name="Cumulative air-sea flux of Bomb C14"     unit="mol/m2"     />
+       <field id="fdecay"      long_name="Radiactive decay of Bomb C14"            unit="mol/m3"  grid_ref="grid_T_3D"  />
+
+       <!-- IDTRA : variables available with key_idtra -->
+       <field id="qtrIDTRA"    long_name="Air-sea flux of Ideal Tracer"             unit="mol/m2/s"   />
+       <field id="qintIDTRA"   long_name="Cumulative air-sea flux of Ideal Tracer"  unit="mol/m2"     />
+       <field id="invIDTRA"    long_name="Vertical inventory"                       unit="mol/m2"     />
+
+       <!-- MEDUSA additional diagnostics on T grid  -->
+       <field id= "INVTN"      long_name="Column N inventory"                        unit="mmolN/m2"    />
+       <field id= "INVTSI"     long_name="Column Si inventory"                       unit="mmolSi/m2"   />
+       <field id= "INVTFE"     long_name="Column Fe inventory"                       unit="mmolFe/m2"   />
+       <field id= "PRN"        long_name="Non-diatom primary production"             unit="mmolN/m2/d"  />
+       <field id= "MPN"        long_name="Non-diatom non-grazing losses"             unit="mmolN/m2/d"  />
+       <field id= "PRD"        long_name="Diatom primary production"                 unit="mmolN/m2/d"  />
+       <field id= "MPD"        long_name="Diatom non-grazing losses"                 unit="mmolN/m2/d"  />
+       <field id= "DSED"       long_name="Gravitational sinking of Detritus"         unit="mmolN/m2/d"  />
+       <field id= "OPAL"       long_name="Diatom biogenic opal production"           unit="mmolSi/m2/d" />
+       <field id= "OPALDISS"   long_name="Diatom biogenic opal dissolution"          unit="mmolSi/m2/d" />
+       <field id= "GMIPn"      long_name="Microzoo grazing on non-diatoms"           unit="mmolN/m2/d"  />
+       <field id= "GMID"       long_name="Microzoo grazing on detritus"              unit="mmolN/m2/d"  />
+       <field id= "MZMI"       long_name="Microzoo non-grazing losses"               unit="mmolN/m2/d"  />
+       <field id= "GMEPN"      long_name="Mesozoo grazing on non-diatoms"            unit="mmolN/m2/d"  />
+       <field id= "GMEPD"      long_name="Mesozoo grazing on non-diatoms"            unit="mmolN/m2/d"  />
+       <field id= "GMEZMI"     long_name="Mesozoo grazing on microzoo"               unit="mmolN/m2/d"  />
+       <field id= "GMED"       long_name="Mesozoo grazing on detritus"               unit="mmolN/m2/d"  />
+       <field id= "MZME"       long_name="Mesozoo non-grazing losses"                unit="mmolN/m2/d"  />
+       <field id= "DEXP"       long_name="Detritus export"                           unit="mmolN/m2/d"  />
+       <field id= "DETN"       long_name="Slow detritus creation"                    unit="mmolN/m2/d"  />
+       <field id= "MDET"       long_name="Detritus non-grazing losses"               unit="MmolN/m2/d"  />
+       <field id= "AEOLIAN"    long_name="Aeolian deposition of iron"                unit="mmolFe/m2/d" />
+       <field id= "BENTHIC"    long_name="Benthic supply of iron"                    unit="mmolFe/m2/d" />
+       <field id= "SCAVENGE"   long_name="Scavenged iron"                            unit="mmolFe/m2/d" />
+       <field id= "PN_JLIM"    long_name="Non-diatom light limitation"               unit="-"           />
+       <field id= "PN_NLIM"    long_name="Non-diatom N limitation"                   unit="-"           />
+       <field id= "PN_FELIM"   long_name="Non-diatom Fe limitation"                  unit="-"           />
+       <field id= "PD_JLIM"    long_name="Diatom light limitation"                   unit="-"           />
+       <field id= "PD_NLIM"    long_name="Diatom N limitation"                       unit="-"           />
+       <field id= "PD_FELIM"   long_name="Diatom Fe limitation"                      unit="-"           />
+       <field id= "PD_SILIM"   long_name="Diatom Si limitation"                      unit="-"           />
+       <field id= "PDSILIM2"   long_name="Diatom Si uptake limitation"               unit="-"           />
+       <field id= "SDT__100"   long_name="Slow detrital flux at  100 m"              unit="mmolN/m2/d"  />
+       <field id= "SDT__200"   long_name="Slow detrital flux at  200 m"              unit="mmolN/m2/d"  />
+       <field id= "SDT__500"   long_name="Slow detrital flux at  500 m"              unit="mmolN/m2/d"  />
+       <field id= "SDT_1000"   long_name="Slow detrital flux at 1000 m"              unit="mmolN/m2/d"  />
+       <field id= "TOTREG_N"   long_name="Full column regenerated N"                 unit="mmolN/m2/d"  />
+       <field id= "TOTRG_SI"   long_name="Full column regenerated Si"                unit="mmolSi/m2/d" />
+       <field id= "REG__100"   long_name="Regenerated N to  100 m"                   unit="mmolN/m2/d"  />
+       <field id= "REG__200"   long_name="Regenerated N to  200 m"                   unit="mmolN/m2/d"  />
+       <field id= "REG__500"   long_name="Regenerated N to  500 m"                   unit="mmolN/m2/d"  />
+       <field id= "REG_1000"   long_name="Regenerated N to 1000 m"                   unit="mmolN/m2/d"  />
+       <field id= "FASTN"      long_name="Fast-sinking flux N"                       unit="mmolN/m2/d"  />
+       <field id= "FASTSI"     long_name="Fast-sinking flux Si"                      unit="mmolSi/m2/d" />
+       <field id= "FASTFE"     long_name="Fast-sinking flux Fe"                      unit="mmolFe/m2/d" />
+       <field id= "FASTC"      long_name="Fast-sinking flux C"                       unit="mmolC/m2/d"  />
+       <field id= "FASTCA"     long_name="Fast-sinking flux CaCO3"                   unit="mmolC/m2/d"  />
+       <field id= "FDT__100"   long_name="Fast detrital N flux at  100 m"            unit="mmolN/m2/d"  />
+       <field id= "FDT__200"   long_name="Fast detrital N flux at  200 m"            unit="mmolN/m2/d"  />
+       <field id= "FDT__500"   long_name="Fast detrital N flux at  500 m"            unit="mmolN/m2/d"  />
+       <field id= "FDT_1000"   long_name="Fast detrital N flux at 1000 m"            unit="mmolN/m2/d"  />
+       <field id= "RG__100F"   long_name="Regenerated fast N to  100 m"              unit="mmolN/m2/d"  />
+       <field id= "RG__200F"   long_name="Regenerated fast N to  200 m"              unit="mmolN/m2/d"  />
+       <field id= "RG__500F"   long_name="Regenerated fast N to  500 m"              unit="mmolN/m2/d"  />
+       <field id= "RG_1000F"   long_name="Regenerated fast N to 1000 m"              unit="mmolN/m2/d"  />
+       <field id= "FDS__100"   long_name="Fast detrital Si flux at  100 m"           unit="mmolSi/m2/d" />
+       <field id= "FDS__200"   long_name="Fast detrital Si flux at  200 m"           unit="mmolSi/m2/d" />
+       <field id= "FDS__500"   long_name="Fast detrital Si flux at  500 m"           unit="mmolSi/m2/d" />
+       <field id= "FDS_1000"   long_name="Fast detrital Si flux at 1000 m"           unit="mmolSi/m2/d" />
+       <field id= "RGS_100F"   long_name="Regenerated fast Si to  100 m"             unit="mmolSi/m2/d" />
+       <field id= "RGS_200F"   long_name="Regenerated fast Si to  200 m"             unit="mmolSi/m2/d" />
+       <field id= "RGS_500F"   long_name="Regenerated fast Si to  500 m"             unit="mmolSi/m2/d" />
+       <field id= "RGS1000F"   long_name="Regenerated fast Si to 1000 m"             unit="mmolSi/m2/d" />
+       <field id= "REMINN"     long_name="Fast-sinking remin flux N"                 unit="mmolN/m2/d"  />
+       <field id= "REMINSI"    long_name="Fast-sinking remin flux Si"                unit="mmolSi/m2/d" />
+       <field id= "REMINFE"    long_name="Fast-sinking remin flux Fe"                unit="mmolFe/m2/d" />
+       <field id= "REMINC"     long_name="Fast-sinking remin flux C"                 unit="mmolC/m2/d"  />
+       <field id= "REMINCA"    long_name="Fast-sinking remin flux CaCO3"             unit="mmolC/m2/d"  />
+       <field id= "SEAFLRN"    long_name="Seafloor flux of N"                        unit="mmolN/m2/d"  />
+       <field id= "SEAFLRSI"   long_name="Seafloor flux of Si"                       unit="mmolSi/m2/d" />
+       <field id= "SEAFLRFE"   long_name="Seafloor flux of Fe"                       unit="mmolFe/m2/d" />
+       <field id= "SEAFLRC"    long_name="Seafloor flux of C"                        unit="mmolC/m2/d"  />
+       <field id= "SEAFLRCA"   long_name="Seafloor flux of CaCO3"                    unit="mmolC/m2/d"  />
+       <field id= "MED_QSR"    long_name="Sea surface radiation"                     unit="W/m2"        />
+       <field id= "MED_XPAR"   long_name="Top level radiation"                       unit="W/m2"        />
+       <field id= "INTFLX_N"   long_name="Integrated N  cycle fluxes"                unit="mmolN/m2/d"  />
+       <field id= "INTFLX_SI"  long_name="Integrated Si cycle fluxes"                unit="mmolSi/m2/d" />
+       <field id= "INTFLX_FE"  long_name="Integrated Fe cycle fluxes"                unit="mmolFe/m2/d" />
+       <field id= "INT_PN"     long_name="Vertically integrated Pn"                  unit="mmolN/m2"    />
+       <field id= "INT_PD"     long_name="Vertically integrated Pd"                  unit="mmolN/m2"    />
+       <field id= "ML_PRN"     long_name="Non-diatom mixed layer PP"                 unit="mmolN/m2/d"  />
+       <field id= "ML_PRD"     long_name="Diatom mixed layer PP"                     unit="mmolN/m2/d"  />
+       <field id= "OCAL_CCD"   long_name="Calcite CCD depth"                         unit="m"           />
+       <field id= "OCAL_LVL"   long_name="Calcite CCD level"                         unit="-"           />
+       <field id= "FE_0000"    long_name="Free iron at    0m"                        unit="-"           />
+       <field id= "FE_0100"    long_name="Free iron at  100m"                        unit="-"           />
+       <field id= "FE_0200"    long_name="Free iron at  200m"                        unit="-"           />
+       <field id= "FE_0500"    long_name="Free iron at  500m"                        unit="-"           />
+       <field id= "FE_1000"    long_name="Free iron at 1000m"                        unit="-"           />
+       <field id= "MED_XZE"    long_name="Euphotic depth"                            unit="m"           />
+       <field id= "WIND"       long_name="Surface scalar wind"                       unit="m/s"         />
+       <field id= "ATM_PCO2"   long_name="Atmospheric pCO2"                          unit="uatm"        />
+       <field id= "OCN_PH"     long_name="Surface ocean pH"                          unit="-"           />
+       <field id= "OCN_PCO2"   long_name="Surface ocean pCO2"                        unit="uatm"        />
+       <field id= "OCNH2CO3"   long_name="Surface ocean H2CO3 conc"                  unit="mmolC/m3"    />
+       <field id= "OCN_HCO3"   long_name="Surface ocean HCO3 conc"                   unit="mmolC/m3"    />
+       <field id= "OCN_CO3"    long_name="Surface ocean CO3 conc"                    unit="mmolC/m3"    />
+       <field id= "CO2FLUX"    long_name="Air-sea CO2 flux"                          unit="mmolC/m2/d"  />
+       <field id= "FGCO2"      long_name="Surface Downward CO2 Flux"                 unit="kg-CO2/m2/s" />
+       <field id= "OM_CAL"     long_name="Omega calcite"                             unit="-"           />
+       <field id= "OM_ARG"     long_name="Omega aragonite"                           unit="-"           />
+       <field id= "TCO2"       long_name="Total CO2"                                 unit="umol/kg"     />
+       <field id= "TALK"       long_name="Total alkalinity"                          unit="ueq/kg"      />
+       <field id= "KW660"      long_name="Piston velocity"                           unit="m/s"         />
+       <field id= "ATM_PP0"    long_name="Atmospheric pressure"                      unit="atm"         />
+       <field id= "O2FLUX"     long_name="Air-sea O2 flux"                           unit="mmolO2/m2/d" />
+       <field id= "O2SAT"      long_name="Surface ocean O2 saturation"               unit="mmolO2/m3"   />
+       <field id= "CAL_CCD"    long_name="Calcite CCD depth"                         unit="m"           />
+       <field id= "ARG_CCD"    long_name="Aragonite CCD depth"                       unit="m"           />
+       <field id= "SFR_OCAL"   long_name="Seafloor omega calcite"                    unit="-"           />
+       <field id= "SFR_OARG"   long_name="Seafloor omega aragonite"                  unit="-"           />
+       <field id= "N_PROD"     long_name="Nitrogen production"                       unit="mmolN/m2/d"  />
+       <field id= "N_CONS"     long_name="Nitrogen consumption"                      unit="mmolN/m2/d"  />
+       <field id= "C_PROD"     long_name="Carbon production"                         unit="mmolC/m2/d"  />
+       <field id= "C_CONS"     long_name="Carbon consumption"                        unit="mmolC/m2/d"  />
+       <field id= "O2_PROD"    long_name="Oxygen production"                         unit="mmolO2/m2/d" />
+       <field id= "O2_CONS"    long_name="Oxygen consumption"                        unit="mmolO2/m2/d" />
+       <field id= "O2_ANOX"    long_name="Unrealised oxygen consumption"             unit="mmolO2/m2/d" />
+       <field id= "RR_0100"    long_name="Rain ratio at  100m"                       unit="molC/molC"   />
+       <field id= "RR_0500"    long_name="Rain ratio at  500m"                       unit="molC/molC"   />
+       <field id= "RR_1000"    long_name="Rain ratio at 1000m"                       unit="molC/molC"   />
+       <field id= "IBEN_N"     long_name="Benthic input nitrogen"                    unit="mmolN/m2/d"  />
+       <field id= "IBEN_FE"    long_name="Benthic input iron"                        unit="mmolFe/m2/d" />
+       <field id= "IBEN_C"     long_name="Benthic input carbon"                      unit="mmolC/m2/d"  />
+       <field id= "IBEN_SI"    long_name="Benthic input silicon"                     unit="mmolSi/m2/d" />
+       <field id= "IBEN_CA"    long_name="Benthic input CaCO3"                       unit="mmolC/m2/d"  />
+       <field id= "OBEN_N"     long_name="Benthic output nitrogen"                   unit="mmolN/m2/d"  />
+       <field id= "OBEN_FE"    long_name="Benthic output iron"                       unit="mmolFe/m2/d" />
+       <field id= "OBEN_C"     long_name="Benthic output carbon"                     unit="mmolC/m2/d"  />
+       <field id= "OBEN_SI"    long_name="Benthic output silicon"                    unit="mmolSi/m2/d" />
+       <field id= "OBEN_CA"    long_name="Benthic output CaCO3"                      unit="mmolC/m2/d"  />
+       <field id= "BEN_N"      long_name="Benthic nitrogen"                          unit="mmolN/m2"    />
+       <field id= "BEN_FE"     long_name="Benthic iron"                              unit="mmolFe/m2"   />
+       <field id= "BEN_C"      long_name="Benthic carbon"                            unit="mmolC/m2"    />
+       <field id= "BEN_SI"     long_name="Benthic silicon"                           unit="mmolSi/m2"   />
+       <field id= "BEN_CA"     long_name="Benthic CaCO3"                             unit="mmolC/m2"    />
+       <field id= "RUNOFF"     long_name="River runoff"                              unit="m/d"         />
+       <field id= "RIV_N"      long_name="Riverine input nitrogen"                   unit="mmolN/m2/d"  />
+       <field id= "RIV_SI"     long_name="Riverine input silicon"                    unit="mmolSi/m2/d" />
+       <field id= "RIV_C"      long_name="Riverine input carbon"                     unit="mmolSi/m2/d" />
+       <field id= "RIV_ALK"    long_name="Riverine input alkalinity"                 unit="meq/m2/d"    />
+       <field id= "DETC"       long_name="Slow detritus C creation"                  unit="mmolC/m2/d"  />
+       <field id= "SDC__100"   long_name="Slow detrital C flux at  100 m"            unit="mmolC/m2/d"  />
+       <field id= "SDC__200"   long_name="Slow detrital C flux at  200 m"            unit="mmolC/m2/d"  />
+       <field id= "SDC__500"   long_name="Slow detrital C flux at  500 m"            unit="mmolC/m2/d"  />
+       <field id= "SDC_1000"   long_name="Slow detrital C flux at 1000 m"            unit="mmolC/m2/d"  />
+       <field id= "INVTC"      long_name="Column C inventory"                        unit="mmolC/m2"    />
+       <field id= "INVTALK"    long_name="Column alkalinity inventory"               unit="meq/m2"      />
+       <field id= "INVTO2"     long_name="Column O2 inventory"                       unit="mmolO2/m2"   />
+       <field id= "LYSO_CA"    long_name="Incorrect benthic output CaCO3"            unit="mmolC/m2/d"  />
+       <field id= "COM_RESP"   long_name="Community respiration"                     unit="mmolC/m2/d"  />
+       <field id= "PN_LLOSS"   long_name="Non-diatom linear losses"                  unit="mmolN/m2/d"  />
+       <field id= "PD_LLOSS"   long_name="Diatom linear losses"                      unit="mmolN/m2/d"  />
+       <field id= "ZI_LLOSS"   long_name="Microzooplankton linear losses"            unit="mmolN/m2/d"  />
+       <field id= "ZE_LLOSS"   long_name="Mesozooplankton linear losses"             unit="mmolN/m2/d"  />
+       <field id= "ZI_MES_N"   long_name="Microzoo messy feeding loss to N"          unit="mmolN/m2/d"  />
+       <field id= "ZI_MES_D"   long_name="Microzoo messy feeding loss to D"          unit="mmolN/m2/d"  />
+       <field id= "ZI_MES_C"   long_name="Microzoo messy feeding loss to C"          unit="mmolC/m2/d"  />
+       <field id= "ZI_MESDC"   long_name="Microzoo messy feeding loss to Dc"         unit="mmolC/m2/d"  />
+       <field id= "ZI_EXCR"    long_name="Microzoo excretion"                        unit="mmolN/m2/d"  />
+       <field id= "ZI_RESP"    long_name="Microzoo respiration"                      unit="mmolC/m2/d"  />
+       <field id= "ZI_GROW"    long_name="Microzoo growth"                           unit="mmolN/m2/d"  />
+       <field id= "ZE_MES_N"   long_name="Mesozoo messy feeding loss to N"           unit="mmolN/m2/d"  />
+       <field id= "ZE_MES_D"   long_name="Mesozoo messy feeding loss to D"           unit="mmolN/m2/d"  />
+       <field id= "ZE_MES_C"   long_name="Mesozoo messy feeding loss to C"           unit="mmolC/m2/d"  />
+       <field id= "ZE_MESDC"   long_name="Mesozoo messy feeding loss to Dc"          unit="mmolC/m2/d"  />
+       <field id= "ZE_EXCR"    long_name="Mesozoo excretion"                         unit="mmolN/m2/d"  />
+       <field id= "ZE_RESP"    long_name="Mesozoo respiration"                       unit="mmolC/m2/d"  />
+       <field id= "ZE_GROW"    long_name="Mesozoo growth"                            unit="mmolN/m2/d"  />
+       <field id= "MDETC"      long_name="Detritus non-grazing losses, carbon"       unit="mmolC/m2/d"  />
+       <field id= "GMIDC"      long_name="Microzoo grazing on detritus, carbon"      unit="mmolC/m2/d"  />
+       <field id= "GMEDC"      long_name="Mesozoo  grazing on detritus, carbon"      unit="mmolC/m2/d"  />
+       <field id= "INT_ZMI"    long_name="Vertically integrated Zmi"                 unit="mmolN/m2"    />
+       <field id= "INT_ZME"    long_name="Vertically integrated Zme"                 unit="mmolN/m2"    />
+       <field id= "INT_DET"    long_name="Vertically integrated Det"                 unit="mmolN/m2"    />
+       <field id= "INT_DTC"    long_name="Vertically integrated Dtc"                 unit="mmolC/m2"    />
+       <field id= "DMS_SURF"   long_name="DMS Surface Concentration"                 unit="nmol/L"      />
+       <field id= "DMS_ANDR"   long_name="DMS Surface Concentration, Anderson"       unit="nmol/L"      />
+       <field id= "DMS_SIMO"   long_name="DMS Surface Concentration, SimoDach"       unit="nmol/L"      />
+       <field id= "DMS_ARAN"   long_name="DMS Surface Concentration, AranamiT"       unit="nmol/L"      />
+       <field id= "DMS_HALL"   long_name="DMS Surface Concentration, Halloran"       unit="nmol/L"      />
+       <field id= "ATM_XCO2"   long_name="Atmospheric xCO2"                          unit="ppm"         />
+       <field id= "OCN_FCO2"   long_name="Surface ocean fCO2"                        unit="uatm"        />
+       <field id= "ATM_FCO2"   long_name="Atmospheric fCO2"                          unit="uatm"        />
+       <field id= "OCN_RHOSW"  long_name="MOCSY rhoSW"                               unit="kg/m3"       />
+       <field id= "OCN_SCHCO2" long_name="MOCSY Schmidt CO2"                         unit="-"           />
+       <field id= "OCN_KWCO2"  long_name="MOCSY kw CO2"                              unit="m/s"         />
+       <field id= "OCN_K0"     long_name="MOCSY k0"                                  unit="(mol/kg)/atm" />
+       <field id= "CO2STARAIR" long_name="MOCSY CO2star air"                         unit="mmol/m3"     />
+       <field id= "OCN_DPCO2"  long_name="MOCSY delta pCO2"                          unit="uatm"        />
+       
+
+       <!-- AXY (08/11/16): add new 2D CMIP6 diagnostics -->
+       <field id= "epC100"     long_name="Downward Flux of Particle Organic Carbon"  unit="mmolC/m2/d"  />
+       <field id= "epCALC100"  long_name="Downward Flux of Calcite"                  unit="mmolC/m2/d"  />
+       <field id= "epN100"     long_name="Downward Flux of Particulate Nitrogen"     unit="mmolN/m2/d"  />
+       <field id= "epSI100"    long_name="Downward Flux of Particulate Silica"       unit="mmolSi/m2/d" />
+       <field id= "INTDISSIC"  long_name="Dissolved Inorganic Carbon Content"        unit="mmolC/m2"    />
+       <field id= "INTDISSIN"  long_name="Dissolved Inorganic Nitrogen Content"      unit="mmolN/m2"    />
+       <field id= "INTDISSISI" long_name="Dissolved Inorganic Silicon Content"       unit="mmolSi/m2"   />
+       <field id= "INTTALK"    long_name="Dissolved Alkalinity Content"              unit="meq/m2"      />
+       <field id= "O2min"      long_name="Oxygen Minimum Concentration"              unit="mmolO2/m3"   />
+       <field id= "ZO2min"     long_name="Depth of Oxygen Minimum Concentration"     unit="m"           />
+       <field id= "FBDDTALK"   long_name="Int. change of Alkalinity due to Biology"  unit="meq/m2/d"    />
+       <field id= "FBDDTDIC"   long_name="Int. change of DI Carbon due to Biology"   unit="mmolC/m2/d"  />
+       <field id= "FBDDTDIFE"  long_name="Int. change of DI Iron due to Biology"     unit="mmolFe/m2/d" />
+       <field id= "FBDDTDIN"   long_name="Int. change of DI Nitrogen due to Biology" unit="mmolN/m2/d"  />
+       <field id= "FBDDTDISI"  long_name="Int. change of DI Silicon due to Biology"  unit="mmolSi/m2/d" />
+       
+
+       <!-- MEDUSA 3D diagnostics -->
+       <field id= "TPP3"       long_name="Total primary production 3D"               unit="mmolN/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "DETFLUX3"   long_name="Total detrital flux 3D"                    unit="mmolN/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "REMIN3N"    long_name="Total remin flux N 3D"                     unit="mmolN/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "PH3"        long_name="Ocean pH 3D"                               unit="-"             grid_ref="grid_T_3D"  />
+       <field id= "OM_CAL3"    long_name="Omega calcite 3D"                          unit="-"             grid_ref="grid_T_3D"  />
+
+       <!-- AXY (08/11/16): add new 3D CMIP6 diagnostics -->
+       <field id= "TPPD3"      long_name="Diatom primary production 3D"              unit="mmolN/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "BDDTALK3"   long_name="Change of Alkalinity due to Biology"       unit="meq/m3/d"      grid_ref="grid_T_3D"  />
+       <field id= "BDDTDIC3"   long_name="Change of DI Carbon due to Biology"        unit="mmolC/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "BDDTDIFE3"  long_name="Change of DI Iron due to Biology"          unit="mmolFe/m3/d"   grid_ref="grid_T_3D"  />
+       <field id= "BDDTDIN3"   long_name="Change of DI Nitrogen due to Biology"      unit="mmolN/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "BDDTDISI3"  long_name="Change of DI Silicon due to Biology"       unit="mmolSi/m3/d"   grid_ref="grid_T_3D"  />
+       <field id= "FD_NIT3"    long_name="Fast sinking detrital nitrogen"            unit="mmolN/m2/d"    grid_ref="grid_T_3D"  />
+       <field id= "FD_SIL3"    long_name="Fast sinking detrital silicon"             unit="mmolSi/m2/d"   grid_ref="grid_T_3D"  />
+       <field id= "FD_CAR3"    long_name="Fast sinking detrital carbon"              unit="mmolC/m2/d"    grid_ref="grid_T_3D"  />
+       <field id= "FD_CAL3"    long_name="Fast sinking detrital calcium carbonate"   unit="mmolC/m2/d"    grid_ref="grid_T_3D"  />
+       <field id= "CO33"       long_name="Carbonate ion concentration"               unit="mmolC/m3"      grid_ref="grid_T_3D"  />
+       <field id= "CO3SATARAG3" long_name="Carbonate aragonite saturation conc"      unit="mmolC/m3"      grid_ref="grid_T_3D"  />
+       <field id= "CO3SATCALC3" long_name="Carbonate calcite saturation conc"        unit="mmolC/m3"      grid_ref="grid_T_3D"  />
+       <field id= "DCALC3"     long_name="Calcite dissolution"                       unit="mmolC/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "EXPC3"      long_name="Downward Flux of Particulate Org Carbon"   unit="mmolC/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "EXPN3"      long_name="Downward Flux of Particulate Org Nitrogen" unit="mmolN/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "FEDISS3"    long_name="Particle Source of Dissolved Iron"         unit="mmolFe/m3/d"   grid_ref="grid_T_3D"  />
+       <field id= "FESCAV3"    long_name="Nonbiogenic Iron Scavenging"               unit="mmolFe/m3/d"   grid_ref="grid_T_3D"  />
+       <field id= "MIGRAZP3"   long_name="Microzooplankton grazing on phytoplankton" unit="mmolC/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "MIGRAZD3"   long_name="Microzooplankton grazing on detritus"      unit="mmolC/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "MEGRAZP3"   long_name="Mesozooplankton grazing on phytoplankton"  unit="mmolC/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "MEGRAZD3"   long_name="Mesozooplankton grazing on detritus"       unit="mmolC/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "MEGRAZZ3"   long_name="Mesozooplankton grazing on microzoop"      unit="mmolC/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "O2SAT3"     long_name="Dissolved Oxygen Saturation Concentration" unit="mmolO2/m3"     grid_ref="grid_T_3D"  />
+       <field id= "PBSI3"      long_name="Biogenic Silica Production"                unit="mmolSi/m3/d"   grid_ref="grid_T_3D"  />
+       <field id= "PCAL3"      long_name="Biogenic Calcite Production"               unit="mmolC/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "REMOC3"     long_name="Remineralization of Organic Carbon"        unit="mmolC/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "PNLIMJ3"    long_name="Irradiance limitation of non-diatoms"      unit="-"             grid_ref="grid_T_3D"  />
+       <field id= "PNLIMN3"    long_name="Nitrogen limitation of non-diatoms"        unit="-"             grid_ref="grid_T_3D"  />
+       <field id= "PNLIMFE3"   long_name="Iron limitation of non-diatoms"            unit="-"             grid_ref="grid_T_3D"  />
+       <field id= "PDLIMJ3"    long_name="Irradiance limitation of diatoms"          unit="-"             grid_ref="grid_T_3D"  />
+       <field id= "PDLIMN3"    long_name="Nitrogen limitation of diatoms"            unit="-"             grid_ref="grid_T_3D"  />
+       <field id= "PDLIMFE3"   long_name="Iron limitation of diatoms"                unit="-"             grid_ref="grid_T_3D"  />
+       <field id= "PDLIMSI3"   long_name="Silicon limitation of diatoms"             unit="-"             grid_ref="grid_T_3D"  />
+
+     </field_group>
+
+     <field_group id="PISCES_scalar"  domain_ref="1point" >
+       <field id="pno3tot"         long_name="global mean nitrate concentration"                  unit="mol/m3"   />
+       <field id="ppo4tot"         long_name="global mean phosphorus concentration"               unit="mol/m3"   />
+       <field id="psiltot"         long_name="global mean silicate concentration"                 unit="mol/m3"   />
+       <field id="palktot"         long_name="global mean alkalinity concentration"               unit="mol/m3"   />
+       <field id="pfertot"         long_name="global mean iron concentration"                     unit="mol/m3"   />
+       <field id="tcflx"           long_name="total Flux of Carbon out of the ocean"              unit="mol/s"   />
+       <field id="tcflxcum"        long_name="cumulative total Flux of Carbon out of the ocean"   unit="mol/s"   />
+       <field id="tcexp"           long_name="total Carbon export at 100m"                        unit="mol/s"   />
+       <field id="tintpp"          long_name="global total integrated primary production"         unit="mol/s"   />
+       <field id="tnfix"           long_name="global total nitrogen fixation"                     unit="mol/s"   />
+       <field id="tdenit"          long_name="Total denitrification"                              unit="mol/s"   />
+     </field_group>
+
+    <!-- 
+============================================================================================================
+                                        Definitions for iodef_demo.xml
+============================================================================================================
+    -->
+
+    <field_group id="groupMEDUSA" >
+      <field field_ref="CHN"   name="CHN"   />
+      <field field_ref="CHD"   name="CHD"   />
+      <field field_ref="PHN"   name="PHN"   />
+      <field field_ref="PHD"   name="PHD"   />
+      <field field_ref="ZMI"   name="ZMI"   />
+      <field field_ref="ZME"   name="ZME"   />
+      <field field_ref="DIN"   name="DIN"   />
+      <field field_ref="SIL"   name="SIL"   />
+      <field field_ref="FER"   name="FER"   />
+      <field field_ref="DET"   name="DET"   />
+      <field field_ref="PDS"   name="PDS"   />
+      <field field_ref="DTC"   name="DTC"   />
+      <field field_ref="DiC"   name="DIC"   />
+      <field field_ref="ALK"   name="ALK"   />
+      <field field_ref="OXY"   name="OXY"   />
+      </field_group>
+
+    <field_group id="groupIDTRA" >
+      <field field_ref="IDTRA" name="IDTRA" />
+    </field_group>
+
+    <field_group id="groupIDTRA_dia" >
+      <field field_ref="qtrIDTRA"    name="qtrIDTRA"  />
+      <field field_ref="qintIDTRA"   name="qintIDTRA" />
+      <field field_ref="invIDTRA"    name="invIDTRA"  />
+    </field_group>
+
+    <field_group id="groupCFC" >
+      <field field_ref="CFC11" name="CFC11" />
+    </field_group>
+
+    <field_group id="groupCFC_dia" >
+      <field field_ref="qtrCFC11"    name="qtrCFC11"   />
+      <field field_ref="qintCFC11"   name="qintCFC11"  />
+    </field_group>
+
+    <field_group id="groupAGE" >
+      <field field_ref="Age" name="Age" />
+    </field_group>
+
+    <field_group id="groupMEDUSA_dia" >
+      <field field_ref= "INVTN"      name="INVTN"      />
+      <field field_ref= "INVTSI"     name="INVTSI"     />
+      <field field_ref= "INVTFE"     name="INVTFE"     />
+      <field field_ref= "PRN"        name="PRN"        />
+      <field field_ref= "MPN"        name="MPN"        />
+      <field field_ref= "PRD"        name="PRD"        />
+      <field field_ref= "MPD"        name="MPD"        />
+      <field field_ref= "OPAL"       name="OPAL"       />
+      <field field_ref= "OPALDISS"   name="OPALDISS"   />
+      <field field_ref= "GMIPn"      name="GMIPn"      />
+      <field field_ref= "GMID"       name="GMID"       />
+      <field field_ref= "MZMI"       name="MZMI"       />
+      <field field_ref= "GMEPN"      name="GMEPN"      />
+      <field field_ref= "GMEPD"      name="GMEPD"      />
+      <field field_ref= "GMEZMI"     name="GMEZMI"     />
+      <field field_ref= "GMED"       name="GMED"       />
+      <field field_ref= "MZME"       name="MZME"       />
+      <field field_ref= "DETN"       name="DETN"       />
+      <field field_ref= "MDET"       name="MDET"       />
+      <field field_ref= "AEOLIAN"    name="AEOLIAN"    />
+      <field field_ref= "BENTHIC"    name="BENTHIC"    />
+      <field field_ref= "SCAVENGE"   name="SCAVENGE"   />
+      <field field_ref= "PN_JLIM"    name="PN_JLIM"    />
+      <field field_ref= "PN_NLIM"    name="PN_NLIM"    />
+      <field field_ref= "PN_FELIM"   name="PN_FELIM"   />
+      <field field_ref= "PD_JLIM"    name="PD_JLIM"    />
+      <field field_ref= "PD_NLIM"    name="PD_NLIM"    />
+      <field field_ref= "PD_FELIM"   name="PD_FELIM"   />
+      <field field_ref= "PD_SILIM"   name="PD_SILIM"   />
+      <field field_ref= "PDSILIM2"   name="PDSILIM2"   />
+      <field field_ref= "SDT__100"   name="SDT__100"   />
+      <field field_ref= "SDT__200"   name="SDT__200"   />
+      <field field_ref= "SDT__500"   name="SDT__500"   />
+      <field field_ref= "SDT_1000"   name="SDT_1000"   />
+      <field field_ref= "TOTREG_N"   name="TOTREG_N"   />
+      <field field_ref= "TOTRG_SI"   name="TOTRG_SI"   />
+      <field field_ref= "REG__100"   name="REG__100"   />
+      <field field_ref= "REG__200"   name="REG__200"   />
+      <field field_ref= "REG__500"   name="REG__500"   />
+      <field field_ref= "REG_1000"   name="REG_1000"   />
+      <field field_ref= "FASTN"      name="FASTN"      />
+      <field field_ref= "FASTSI"     name="FASTSI"     />
+      <field field_ref= "FASTFE"     name="FASTFE"     />
+      <field field_ref= "FASTC"      name="FASTC"      />
+      <field field_ref= "FASTCA"     name="FASTCA"     />
+      <field field_ref= "FDT__100"   name="FDT__100"   />
+      <field field_ref= "FDT__200"   name="FDT__200"   />
+      <field field_ref= "FDT__500"   name="FDT__500"   />
+      <field field_ref= "FDT_1000"   name="FDT_1000"   /> 
+      <field field_ref= "RG__100F"   name="RG__100F"   />
+      <field field_ref= "RG__200F"   name="RG__200F"   />
+      <field field_ref= "RG__500F"   name="RG__500F"   />
+      <field field_ref= "RG_1000F"   name="RG_1000F"   />
+      <field field_ref= "FDS__100"   name="FDS__100"   />
+      <field field_ref= "FDS__200"   name="FDS__200"   />
+      <field field_ref= "FDS__500"   name="FDS__500"   />
+      <field field_ref= "FDS_1000"   name="FDS_1000"   />
+      <field field_ref= "RGS_100F"   name="RGS_100F"   />
+      <field field_ref= "RGS_200F"   name="RGS_200F"   />
+      <field field_ref= "RGS_500F"   name="RGS_500F"   />
+      <field field_ref= "RGS1000F"   name="RGS1000F"   />
+      <field field_ref= "REMINN"     name="REMINN"     />
+      <field field_ref= "REMINSI"    name="REMINSI"    />
+      <field field_ref= "REMINFE"    name="REMINFE"    />
+      <field field_ref= "SEAFLRN"    name="SEAFLRN"    /> 
+      <field field_ref= "SEAFLRSI"   name="SEAFLRSI"   />
+      <field field_ref= "SEAFLRFE"   name="SEAFLRFE"   />
+      <field field_ref= "SEAFLRC"    name="SEAFLRC"    />
+      <field field_ref= "SEAFLRCA"   name="SEAFLRCA"   />
+      <field field_ref= "MED_QSR"    name="MED_QSR"    />
+      <field field_ref= "MED_XPAR"   name="MED_XPAR"   />
+      <field field_ref= "INTFLX_N"   name="INTFLX_N"   />
+      <field field_ref= "INTFLX_SI"  name="INTFLX_SI"  />
+      <field field_ref= "INTFLX_FE"  name="INTFLX_FE"  />
+      <field field_ref= "INT_PN"     name="INT_PN"     />
+      <field field_ref= "INT_PD"     name="INT_PD"     />
+      <field field_ref= "ML_PRN"     name="ML_PRN"     />
+      <field field_ref= "ML_PRD"     name="ML_PRD"     />
+      <field field_ref= "OCAL_CCD"   name="OCAL_CCD"   />
+      <field field_ref= "OCAL_LVL"   name="OCAL_LVL"   />
+      <field field_ref= "FE_0000"    name="FE_0000"    />
+      <field field_ref= "FE_0100"    name="FE_0100"    />
+      <field field_ref= "FE_0200"    name="FE_0200"    /> 
+      <field field_ref= "FE_0500"    name="FE_0500"    />
+      <field field_ref= "FE_1000"    name="FE_1000"    />
+      <field field_ref= "MED_XZE"    name="MED_XZE"    />
+      <field field_ref= "WIND"       name="WIND"       />
+      <field field_ref= "ATM_PCO2"   name="ATM_PCO2"   />
+      <field field_ref= "OCN_PH"     name="OCN_PH"     />
+      <field field_ref= "OCN_PCO2"   name="OCN_PCO2"   />
+      <field field_ref= "OCNH2CO3"   name="OCNH2CO3"   />
+      <field field_ref= "OCN_HCO3"   name="OCN_HCO3"   />
+      <field field_ref= "OCN_CO3"    name="OCN_CO3"    />
+      <field field_ref= "CO2FLUX"    name="CO2FLUX"    />
+      <field field_ref= "FGCO2"      name="FGCO2"      />
+      <field field_ref= "OM_CAL"     name="OM_CAL"     />
+      <field field_ref= "OM_ARG"     name="OM_ARG"     />
+      <field field_ref= "TCO2"       name="TCO2"       />
+      <field field_ref= "TALK"       name="TALK"       />
+      <field field_ref= "KW660"      name="KW660"      />
+      <field field_ref= "ATM_PP0"    name="ATM_PP0"    />
+      <field field_ref= "O2FLUX"     name="O2FLUX"     />
+      <field field_ref= "O2SAT"      name="O2SAT"      />
+      <field field_ref= "CAL_CCD"    name="CAL_CCD"    />
+      <field field_ref= "ARG_CCD"    name="ARG_CCD"    />
+      <field field_ref= "SFR_OCAL"   name="SFR_OCAL"   />
+      <field field_ref= "SFR_OARG"   name="SFR_OARG"   />
+      <field field_ref= "N_PROD"     name="N_PROD"     />
+      <field field_ref= "N_CONS"     name="N_CONS"     />
+      <field field_ref= "C_PROD"     name="C_PROD"     />
+      <field field_ref= "C_CONS"     name="C_CONS"     />
+      <field field_ref= "O2_PROD"    name="O2_PROD"    />
+      <field field_ref= "O2_CONS"    name="O2_CONS"    />
+      <field field_ref= "O2_ANOX"    name="O2_ANOX"    />
+      <field field_ref= "RR_0100"    name="RR_0100"    />
+      <field field_ref= "RR_0500"    name="RR_0500"    />
+      <field field_ref= "RR_1000"    name="RR_1000"    />
+      <field field_ref= "IBEN_N"     name="IBEN_N"     />
+      <field field_ref= "IBEN_FE"    name="IBEN_FE"    />
+      <field field_ref= "IBEN_C"     name="IBEN_C"     />
+      <field field_ref= "IBEN_SI"    name="IBEN_SI"    />
+      <field field_ref= "IBEN_CA"    name="IBEN_CA"    />
+      <field field_ref= "OBEN_N"     name="OBEN_N"     />
+      <field field_ref= "OBEN_FE"    name="OBEN_FE"    />
+      <field field_ref= "OBEN_C"     name="OBEN_C"     />
+      <field field_ref= "OBEN_SI"    name="OBEN_SI"    />
+      <field field_ref= "OBEN_CA"    name="OBEN_CA"    />
+      <field field_ref= "BEN_N"      name="BEN_N"      />
+      <field field_ref= "BEN_FE"     name="BEN_FE"     />
+      <field field_ref= "BEN_C"      name="BEN_C"      />
+      <field field_ref= "BEN_SI"     name="BEN_SI"     />
+      <field field_ref= "BEN_CA"     name="BEN_CA"     />
+      <field field_ref= "DETC"       name="DETC"       />
+      <field field_ref= "SDC__100"   name="SDC__100"   />
+      <field field_ref= "SDC__200"   name="SDC__200"   />
+      <field field_ref= "SDC__500"   name="SDC__500"   />
+      <field field_ref= "SDC_1000"   name="SDC_1000"   />
+      <field field_ref= "INVTC"      name="INVTC"      />
+      <field field_ref= "INVTALK"    name="INVTALK"    />
+      <field field_ref= "INVTO2"     name="INVTO2"     />
+      <field field_ref= "LYSO_CA"    name="LYSO_CA"    />
+      <field field_ref= "COM_RESP"   name="COM_RESP"   />
+      <field field_ref= "PN_LLOSS"   name="PN_LLOSS"   />
+      <field field_ref= "PD_LLOSS"   name="PD_LLOSS"   />
+      <field field_ref= "ZI_LLOSS"   name="ZI_LLOSS"   />
+      <field field_ref= "ZE_LLOSS"   name="ZE_LLOSS"   />
+      <field field_ref= "ZI_MES_N"   name="ZI_MES_N"   />
+      <field field_ref= "ZI_MES_D"   name="ZI_MES_D"   />
+      <field field_ref= "ZI_MES_C"   name="ZI_MES_C"   />
+      <field field_ref= "ZI_MESDC"   name="ZI_MESDC"   />
+      <field field_ref= "ZI_EXCR"    name="ZI_EXCR"    />
+      <field field_ref= "ZI_RESP"    name="ZI_RESP"    />
+      <field field_ref= "ZI_GROW"    name="ZI_GROW"    />
+      <field field_ref= "ZE_MES_N"   name="ZE_MES_N"   />
+      <field field_ref= "ZE_MES_D"   name="ZE_MES_D"   />
+      <field field_ref= "ZE_MES_C"   name="ZE_MES_C"   />
+      <field field_ref= "ZE_MESDC"   name="ZE_MESDC"   />
+      <field field_ref= "ZE_EXCR"    name="ZE_EXCR"    />
+      <field field_ref= "ZE_RESP"    name="ZE_RESP"    />
+      <field field_ref= "ZE_GROW"    name="ZE_GROW"    />
+      <field field_ref= "MDETC"      name="MDETC"      />
+      <field field_ref= "GMIDC"      name="GMIDC"      />
+      <field field_ref= "GMEDC"      name="GMEDC"      />
+      <field field_ref= "INT_ZMI"    name="INT_ZMI"    />
+      <field field_ref= "INT_ZME"    name="INT_ZME"    />
+      <field field_ref= "INT_DET"    name="INT_DET"    />
+      <field field_ref= "INT_DTC"    name="INT_DTC"    />
+      <field field_ref= "ATM_XCO2"   name="ATM_XCO2"   />
+      <field field_ref= "OCN_FCO2"   name="OCN_FCO2"   />
+      <field field_ref= "ATM_FCO2"   name="ATM_FCO2"   />
+      <field field_ref= "OCN_RHOSW"  name="OCN_RHOSW"  />
+      <field field_ref= "OCN_SCHCO2" name="OCN_SCHCO2" />
+      <field field_ref= "OCN_KWCO2"  name="OCN_KWCO2"  />
+      <field field_ref= "OCN_K0"     name="OCN_K0"     />
+      <field field_ref= "CO2STARAIR" name="CO2STARAIR" />
+      <field field_ref= "OCN_DPCO2"  name="OCN_DPCO2"  />
+    </field_group>
+
+    <field_group id="groupMEDUSA_3dd" >
+      <field field_ref= "TPP3"       name="TPP3"       />
+      <field field_ref= "DETFLUX3"   name="DETFLUX3"   />
+      <field field_ref= "REMIN3N"    name="REMIN3N"    />
+      <field field_ref= "PH3"        name="PH3"        />
+      <field field_ref= "OM_CAL3"    name="OM_CAL3"    /> 
+    </field_group>
+
+    <field_group id="groupMEDUSA_dms" >
+      <field field_ref= "DMS_SURF"   name="DMS_SURF"   />
+      <field field_ref= "DMS_ANDR"   name="DMS_ANDR"   />
+      <field field_ref= "DMS_SIMO"   name="DMS_SIMO"   />
+      <field field_ref= "DMS_ARAN"   name="DMS_ARAN"   />
+      <field field_ref= "DMS_HALL"   name="DMS_HALL"   />
+    </field_group>
+
+    <field_group id="groupMEDUSA_riv" >
+      <field field_ref= "RUNOFF"     name="RUNOFF"     />
+      <field field_ref= "RIV_N"      name="RIV_N"      />
+      <field field_ref= "RIV_SI"     name="RIV_SI"     />
+      <field field_ref= "RIV_C"      name="RIV_C"      />
+      <field field_ref= "RIV_ALK"    name="RIV_ALK"    />
+    </field_group>
+
+    <field_group id="groupMEDUSA_cmip6" >
+      <field field_ref= "epC100"     name="epC100"     />
+      <field field_ref= "epCALC100"  name="epCALC100"  />
+      <field field_ref= "epN100"     name="epN100"     />
+      <field field_ref= "epSI100"    name="epSI100"    />
+      <field field_ref= "INTDISSIC"  name="INTDISSIC"  />
+      <field field_ref= "INTDISSIN"  name="INTDISSIN"  />
+      <field field_ref= "INTDISSISI" name="INTDISSISI" />
+      <field field_ref= "INTTALK"    name="INTTALK"    />
+      <field field_ref= "O2min"      name="O2min"      />
+      <field field_ref= "ZO2min"     name="ZO2min"     />
+      <field field_ref= "FBDDTALK"   name="FBDDTALK"   />
+      <field field_ref= "FBDDTDIC"   name="FBDDTDIC"   />
+      <field field_ref= "FBDDTDIFE"  name="FBDDTDIFE"  />
+      <field field_ref= "FBDDTDIN"   name="FBDDTDIN"   />
+      <field field_ref= "FBDDTDISI"  name="FBDDTDISI"  />
+      <field field_ref= "TPPD3"      name="TPPD3"      />
+      <field field_ref= "BDDTALK3"   name="BDDTALK3"   />
+      <field field_ref= "BDDTDIC3"   name="BDDTDIC3"   />
+      <field field_ref= "BDDTDIFE3"  name="BDDTDIFE3"  />
+      <field field_ref= "BDDTDIN3"   name="BDDTDIN3"   />
+      <field field_ref= "BDDTDISI3"  name="BDDTDISI3"  />
+      <field field_ref= "FD_NIT3"    name="FD_NIT3"    />
+      <field field_ref= "FD_SIL3"    name="FD_SIL3"    />
+      <field field_ref= "FD_CAR3"    name="FD_CAR3"    />
+      <field field_ref= "FD_CAL3"    name="FD_CAL3"    />
+      <field field_ref= "CO33"       name="CO33"       />
+      <field field_ref= "CO3SATARAG3" name="CO3SATARAG3" />
+      <field field_ref= "CO3SATCALC3" name="CO3SATCALC3" />
+      <field field_ref= "DCALC3"     name="DCALC3"     />
+      <field field_ref= "EXPC3"      name="EXPC3"      />
+      <field field_ref= "EXPN3"      name="EXPN3"      />
+      <field field_ref= "FEDISS3"    name="FEDISS3"    />
+      <field field_ref= "FESCAV3"    name="FESCAV3"    />
+      <field field_ref= "MIGRAZP3"   name="MIGRAZP3"   />
+      <field field_ref= "MIGRAZD3"   name="MIGRAZD3"   />
+      <field field_ref= "MEGRAZP3"   name="MEGRAZP3"   />
+      <field field_ref= "MEGRAZD3"   name="MEGRAZD3"   />
+      <field field_ref= "MEGRAZZ3"   name="MEGRAZZ3"   />
+      <field field_ref= "O2SAT3"     name="O2SAT3"     />
+      <field field_ref= "PBSI3"      name="PBSI3"      />
+      <field field_ref= "PCAL3"      name="PCAL3"      />
+      <field field_ref= "REMOC3"     name="REMOC3"     />
+      <field field_ref= "PNLIMJ3"    name="PNLIMJ3"    />
+      <field field_ref= "PNLIMN3"    name="PNLIMN3"    />
+      <field field_ref= "PNLIMFE3"   name="PNLIMFE3"   />
+      <field field_ref= "PDLIMJ3"    name="PDLIMJ3"    />
+      <field field_ref= "PDLIMN3"    name="PDLIMN3"    />
+      <field field_ref= "PDLIMFE3"   name="PDLIMFE3"   />
+      <field field_ref= "PDLIMSI3"   name="PDLIMSI3"   />
+    </field_group>
+
+</field_definition>
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/XIOS2/field_def_bgc_CMIP6.xml
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/XIOS2/field_def_bgc_CMIP6.xml	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/XIOS2/field_def_bgc_CMIP6.xml	(revision 8201)
@@ -0,0 +1,778 @@
+<!--
+<?xml version="1.0"?>
+       -->
+ 
+    <!-- $id$ -->
+    
+    <!-- 
+============================================================================================================
+=                                  definition of all existing variables                                    =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+   <field_definition level="1" prec="8" operation="average" enabled=".TRUE." default_value="1.e20" > <!-- time step automaticaly defined -->
+
+    <!-- 
+============================================================================================================
+                                     Biogeochemistry model variables
+============================================================================================================
+    -->
+
+      <!-- ptrc on T grid -->
+
+     <field_group id="ptrc_T" grid_ref="grid_T_3D">
+       <field id="DIC"          long_name="Dissolved inorganic Concentration"        unit="mmol/m3" />
+       <field id="DIC_E3T"      long_name="DIC * E3T"                                unit="mmol/m2" > DIC * e3t </field >
+       <field id="Alkalini"     long_name="Total Alkalinity Concentration"           unit="mmol/m3" />
+       <field id="Alkalini_E3T" long_name="Alkalini * E3T"                           unit="mmol/m2"  > Alkalini * e3t </field >
+       <field id="O2"           long_name="Oxygen Concentration"                     unit="mmol/m3" />
+       <field id="O2_E3T"       long_name="O2 * E3T"                                 unit="mmol/m2"  > O2 * e3t </field >
+       <field id="CaCO3"        long_name="Calcite Concentration"                    unit="mmol/m3" />
+       <field id="CaCO3_E3T"    long_name="CaCO3 * E3T"                              unit="mmol/m2"  > CaCO3 * e3t </field >
+       <field id="PO4"          long_name="Phosphate Concentration"                  unit="mmol/m3" />
+       <field id="PO4_E3T"      long_name="PO4 * E3T"                                unit="mmol/m2"  > PO4 * e3t </field >
+       <field id="POC"          long_name="Small organic carbon Concentration"       unit="mmol/m3" />
+       <field id="POC_E3T"      long_name="POC * E3T"                                unit="mmol/m2"  > POC * e3t </field >
+       <field id="Si"           long_name="Silicate Concentration"                   unit="mmol/m3" />
+       <field id="Si_E3T"       long_name="Si * E3T"                                 unit="mmol/m2"  > Si * e3t </field >
+       <field id="PHY"          long_name="(Nano)Phytoplankton Concentration"        unit="mmol/m3" />
+       <field id="PHY_E3T"      long_name="PHY * E3T"                                unit="mmol/m2"  > PHY * e3t </field >
+       <field id="ZOO"          long_name="(Micro)Zooplankton Concentration"         unit="mmol/m3" />
+       <field id="ZOO_E3T"      long_name="ZOO2 * E3T"                               unit="mmol/m2"  > ZOO * e3t </field >
+       <field id="DOC"          long_name="Dissolved organic Concentration"          unit="mmol/m3" />
+       <field id="DOC_E3T"      long_name="DOC * E3T"                                unit="mmol/m2"  > DOC * e3t </field >
+       <field id="PHY2"         long_name="Diatoms Concentration"                    unit="mmol/m3" />
+       <field id="PHY2_E3T"     long_name="PHY2 * E3T"                               unit="mmol/m2"  > PHY2 * e3t </field >
+       <field id="ZOO2"         long_name="Mesozooplankton Concentration"            unit="mmol/m3" />
+       <field id="ZOO2_E3T"     long_name="ZOO2 * E3T"                               unit="mmol/m2"  > ZOO2 * e3t </field >
+       <field id="DSi"          long_name="Diatoms Silicate Concentration"           unit="mmol/m3" />
+       <field id="DSi_E3T"      long_name="Dsi * E3T"                                unit="mmol/m2"  > DSi * e3t </field >
+       <field id="Fer"          long_name="Dissolved Iron Concentration"             unit="mmol/m3" />
+       <field id="Fer_E3T"      long_name="Fer * E3T"                                unit="mmol/m2"  > Fer * e3t </field >
+       <field id="BFe"          long_name="Big iron particles Concentration"         unit="mmol/m3" />
+       <field id="BFe_E3T"      long_name="BFe * E3T"                                unit="mmol/m2"  > BFe * e3t </field >
+       <field id="GOC"          long_name="Big organic carbon Concentration"         unit="mmol/m3" />
+       <field id="GOC_E3T"      long_name="GOC * E3T"                                unit="mmol/m2"  > GOC * e3t </field >
+       <field id="SFe"          long_name="Small iron particles Concentration"       unit="mmol/m3" />
+       <field id="SFe_E3T"      long_name="SFe * E3T"                                unit="mmol/m2"  > SFe * e3t </field >
+       <field id="DFe"          long_name="Diatoms iron  Concentration"              unit="mmol/m3" />
+       <field id="DFe_E3T"      long_name="DFe * E3T"                                unit="mmol/m2"  > DFe * e3t </field >
+       <field id="GSi"          long_name="Sinking biogenic Silicate Concentration"  unit="mmol/m3" />
+       <field id="GSi_E3T"      long_name="GSi * E3T"                                unit="mmol/m2"  > GSi * e3t </field >
+       <field id="NFe"          long_name="Nano iron Concentration"                  unit="mmol/m3" />
+       <field id="NFe_E3T"      long_name="NFe * E3T"                                unit="mmol/m2"  > NFe * e3t </field >
+       <field id="NCHL"         long_name="Nano chlorophyl Concentration"            unit="mg/m3"   />
+       <field id="NCHL_E3T"     long_name="NCHL * E3T"                               unit="mmol/m2"  > NCHL * e3t </field >
+       <field id="DCHL"         long_name="Diatoms chlorophyl Concentration"         unit="mg/m3"   />
+       <field id="DCHL_E3T"     long_name="DCHL * E3T"                               unit="mmol/m2"  > DCHL * e3t </field >
+       <field id="NO3"          long_name="Nitrate Concentration"                    unit="mmol/m3" />
+       <field id="NO3_E3T"      long_name="NO3 * E3T"                                unit="mmol/m2"  > NO3 * e3t </field >
+       <field id="NH4"          long_name="Ammonium Concentration"                   unit="mmol/m3" />
+       <field id="NH4_E3T"      long_name="NH4 * E3T"                                unit="mmol/m2"  > NH4 * e3t </field >
+
+      <!-- MEDUSA : variables available with key_medusa -->
+       <field id="CHN"      long_name="Chl-a concentration in non-diatom phytoplankton"   unit="mg Chl/m3" />
+       <field id="CHD"      long_name="Chl-a concentration in     diatom phytoplankton"   unit="mg Chl/m3" />
+       <field id="PHN"      long_name="non-diatom phytoplankton"                          unit="mmol-N/m3" />
+       <field id="PHD"      long_name="diatom     phytoplankton"                          unit="mmol-N/m3" />
+       <field id="ZMI"      long_name="micro zooplankton"                                 unit="mmol-N/m3" />
+       <field id="ZME"      long_name="meso  zooplankton"                                 unit="mmol-N/m3" />
+       <field id="DIN"      long_name="dissolved inorganic nitrogen"                      unit="mmol-N/m3" />
+       <field id="SIL"      long_name="dissolved silicic acid"                            unit="mmolSi/m3" />
+       <field id="FER"      long_name="dissolved iron"                                    unit="mmolFe/m3" />
+       <field id="DET"      long_name="detrital nitrogen"                                 unit="mmol-N/m3" />
+       <field id="PDS"      long_name="biogenic silicon in diatom phytoplankton"          unit="mmolSi/m3" />
+       <field id="DTC"      long_name="detrital carbon"                                   unit="mmol-C/m3" />
+       <field id="DiC"      long_name="dissolved inorganic carbon"                        unit="mmol-C/m3" />
+       <field id="ALK"      long_name="alkalinity"                                        unit="meq/m3"    />
+       <field id="OXY"      long_name="dissolved oxygen"                                  unit="mmolO2/m3" />
+
+      <!-- Ideal traceurs : variables available with key_idtra -->
+       <field id="IDTRA"    long_name="Ideal traceur concentration "                      unit="mmol/m3"    />
+
+       <!-- PISCES with Kriest parametisation : variables available with key_kriest -->
+       <field id="Num"         long_name="Number of organic particles"              unit="1" />
+       <field id="Num_E3T"     long_name="Num * E3T"                                unit="m"  > Num * e3t </field >
+
+       <!-- PISCES light : variables available with key_pisces_reduced -->
+       <field id="DET"         long_name="Detritus"                                 unit="mmol-N/m3" />
+       <field id="DET_E3T"     long_name="DET * E3T"                                unit="mmol-N/m2"  > DET * e3t </field >
+       <field id="DOM"         long_name="Dissolved Organic Matter"                 unit="mmol-N/m3" />
+       <field id="DOM_E3T"     long_name="DOM * E3T"                                unit="mmol-N/m2"  > DOM * e3t </field >
+
+       <!-- CFC11 : variables available with key_cfc -->
+       <field id="CFC11"       long_name="CFC-11 Concentration"                     unit="umol/m3" />
+       <field id="CFC11_E3T"   long_name="CFC11 * E3T"                              unit="umol/m2"  > CFC11 * e3t </field >
+       <!-- Bomb C14 : variables available with key_c14b -->
+       <field id="C14B"        long_name="Bomb C14 Concentration"                   unit="1"         />
+       <field id="C14B_E3T"    long_name="C14B * E3T"                               unit="m"  > C14B * e3t </field >
+       <!-- AGE : variables available with key_age -->
+       <field id="Age"        long_name="Sea Water Age Since Surface contact" standard_name="sea_water_age_since_surface_contact"  unit="yr"         />
+       <field id="Age_e3t"    long_name="Age * e3t"                                 unit="yr * m"  > Age * e3t </field >
+     </field_group>
+
+     <!-- PISCES additional diagnostics on T grid  -->
+
+     <field_group id="diad_T" grid_ref="grid_T_2D">
+       <field id="PH"          long_name="PH"                                      unit="1"          grid_ref="grid_T_3D" />
+       <field id="CO3"         long_name="Bicarbonates"                            unit="mol/m3"     grid_ref="grid_T_3D" />
+       <field id="CO3sat"      long_name="CO3 saturation"                          unit="mol/m3"     grid_ref="grid_T_3D" />
+       <field id="PAR"         long_name="Photosynthetically Available Radiation"  unit="W/m2"       grid_ref="grid_T_3D" />
+       <field id="PARDM"       long_name="Daily mean PAR"                          unit="W/m2"       grid_ref="grid_T_3D" />
+       <field id="PPPHY"       long_name="Primary production of nanophyto"         unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="PPPHY2"      long_name="Primary production of diatoms"           unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="PPNEWN"      long_name="New Primary production of nanophyto"     unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="PPNEWD"      long_name="New Primary production of diatoms"       unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="PBSi"        long_name="Primary production of Si diatoms"        unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="PFeN"        long_name="Primary production of nano iron"         unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="PFeD"        long_name="Primary production of diatoms iron"      unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="xfracal"     long_name="Calcifying fraction"                     unit="1"          grid_ref="grid_T_3D" />
+       <field id="PCAL"        long_name="Calcite production"                      unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="DCAL"        long_name="Calcite dissolution"                     unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="GRAZ1"       long_name="Grazing by microzooplankton"             unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="GRAZ2"       long_name="Grazing by mesozooplankton"              unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="REMIN"       long_name="Oxic remineralization of OM"             unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="DENIT"       long_name="Anoxic remineralization of OM"           unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="Nfix"        long_name="Nitrogen fixation"                       unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="Mumax"       long_name="Maximum growth rate"                     unit="s-1"        grid_ref="grid_T_3D" />
+       <field id="MuN"         long_name="Realized growth rate for nanophyto"      unit="s-1"        grid_ref="grid_T_3D" />
+       <field id="MuD"         long_name="Realized growth rate for diatomes"       unit="s-1"        grid_ref="grid_T_3D" />
+       <field id="LNnut"       long_name="Nutrient limitation term in Nanophyto"   unit=""           grid_ref="grid_T_3D" />
+       <field id="LDnut"       long_name="Nutrient limitation term in Diatoms"     unit=""           grid_ref="grid_T_3D" />
+       <field id="LNFe"        long_name="Iron limitation term in Nanophyto"       unit=""           grid_ref="grid_T_3D" />
+       <field id="LDFe"        long_name="Iron limitation term in Diatoms"         unit=""           grid_ref="grid_T_3D" />
+       <field id="LNlight"     long_name="Light limitation term in Nanophyto"      unit=""           grid_ref="grid_T_3D" />
+       <field id="LDlight"     long_name="Light limitation term in Diatoms"        unit=""           grid_ref="grid_T_3D" />
+       <field id="Fe2"         long_name="Iron II concentration"                   unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="Fe3"         long_name="Iron III concentration"                  unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="FeL1"        long_name="Complexed Iron concentration with L1"    unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="FeL2"        long_name="Complexed Iron concentration with L2"    unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="FeP"         long_name="Precipitated Iron III"                   unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="TL1"         long_name="Total L1 concentration"                  unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="TL2"         long_name="Total L2 concentration"                  unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="pdust"       long_name="dust concentration"                      unit="g/m3"                            />
+       <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="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" />
+       <field id="EPC100"      long_name="Export of carbon particles at 100 m"     unit="mol/m2/s"                        />
+       <field id="EPFE100"     long_name="Export of biogenic iron at 100 m"        unit="mol/m2/s"                        />
+       <field id="EPSI100"     long_name="Export of Silicate at 100 m"             unit="mol/m2/s"                        />
+       <field id="EPCAL100"    long_name="Export of Calcite at 100 m"              unit="mol/m2/s"                        />
+       <field id="EXPC"        long_name="Export of carbon"                        unit="mol/m2/s"   grid_ref="grid_T_3D" />
+       <field id="EXPFE"       long_name="Export of biogenic iron"                 unit="mol/m2/s"   grid_ref="grid_T_3D" />
+       <field id="EXPSI"       long_name="Export of Silicate"                      unit="mol/m2/s"   grid_ref="grid_T_3D" />
+       <field id="EXPCAL"      long_name="Export of Calcite"                       unit="mol/m2/s"   grid_ref="grid_T_3D" />
+       <field id="Cflx"        long_name="DIC flux"                                unit="mol/m2/s"                        />
+       <field id="Oflx"        long_name="Oxygen flux"                             unit="mol/m2/s"                        />
+       <field id="Kg"          long_name="Gas transfer"                            unit="mol/m2/s/uatm"                   />
+       <field id="Dpco2"       long_name="Delta CO2"                               unit="uatm"                            />
+       <field id="Dpo2"        long_name="Delta O2"                                unit="uatm"                            />
+       <field id="Heup"        long_name="Euphotic layer depth"                    unit="m"                               />
+       <field id="Irondep"     long_name="Iron deposition from dust"               unit="mol/m2/s"                        />
+       <field id="Ironsed"     long_name="Iron deposition from sediment"           unit="mol/m2/s"   grid_ref="grid_T_3D" />
+
+
+       <!-- PISCES with Kriest parametisation : variables available with key_kriest -->
+       <field id="EPN100"      long_name="Particulate number flux at 100 m"        unit="mol/m2/s"                        />
+       <field id="EXPN"        long_name="Particulate number flux"                 unit="mol/m2/s"   grid_ref="grid_T_3D" />
+       <field id="XNUM"        long_name="Number of particles in aggregats"        unit="1"          grid_ref="grid_T_3D" />
+       <field id="WSC"         long_name="sinking speed of mass flux"              unit="m2/s"       grid_ref="grid_T_3D" />
+       <field id="WSN"         long_name="sinking speed of number flux"            unit="m2/s"       grid_ref="grid_T_3D" />
+
+       <!-- dbio_T on T grid : variables available with key_diaar5 -->
+       <field id="TPP"         long_name="Total Primary production of phyto"                   unit="mol/m3/s"  grid_ref="grid_T_3D" />
+       <field id="TPNEW"       long_name="New Primary production of phyto"                     unit="mol/m3/s"  grid_ref="grid_T_3D" />
+       <field id="TPBFE"       long_name="Total biogenic iron production"                      unit="mol/m3/s"  grid_ref="grid_T_3D" />
+       <field id="INTDIC"      long_name="DIC content"                                         unit="kg/m2"                          />
+       <field id="O2MIN"       long_name="Oxygen minimum concentration"                        unit="mol/m3"                          />
+       <field id="ZO2MIN"      long_name="Depth of oxygen minimum concentration"               unit="m"                              />
+       <field id="INTNFIX"     long_name="Nitrogen fixation rate : vert. integrated"           unit="mol/m2/s"                       />
+       <field id="INTPPPHY"    long_name="Vertically integrated primary production by nanophy" unit="mol/m2/s"                       />
+       <field id="INTPPPHY2"   long_name="Vertically integrated primary production by diatom"  unit="mol/m2/s"                       />
+       <field id="INTPP"       long_name="Vertically integrated primary production by phyto"   unit="mol/m2/s"                       />
+       <field id="INTPNEW"     long_name="Vertically integrated new primary production"        unit="mol/m2/s"                       />
+       <field id="INTPBFE"     long_name="Vertically integrated of biogenic iron production"   unit="mol/m2/s"                       />
+       <field id="INTPBSI"     long_name="Vertically integrated of biogenic Si production"     unit="mol/m2/s"                       />
+       <field id="INTPCAL"     long_name="Vertically integrated of calcite production"         unit="mol/m2/s"                       />
+
+       <!-- PISCES light : variables available with key_pisces_reduced -->
+       <field id="FNO3PHY"     long_name="FNO3PHY"                                 unit=""          grid_ref="grid_T_3D" /> 
+       <field id="FNH4PHY"     long_name="FNH4PHY"                                 unit=""          grid_ref="grid_T_3D" /> 
+       <field id="FNH4NO3"     long_name="FNH4NO3"                                 unit=""          grid_ref="grid_T_3D" /> 
+       <field id="TNO3PHY"     long_name="TNO3PHY"                                 unit=""  /> 
+       <field id="TNH4PHY"     long_name="TNH4PHY"                                 unit=""  /> 
+       <field id="TPHYDOM"     long_name="TPHYDOM"                                 unit=""  /> 
+       <field id="TPHYNH4"     long_name="TPHYNH4"                                 unit=""  /> 
+       <field id="TPHYZOO"     long_name="TPHYZOO"                                 unit=""  /> 
+       <field id="TPHYDET"     long_name="TPHYDET"                                 unit=""  /> 
+       <field id="TDETZOO"     long_name="TDETZOO"                                 unit=""  /> 
+       <field id="TZOODET"     long_name="TZOODET"                                 unit=""  /> 
+       <field id="TZOOBOD"     long_name="TZOOBOD"                                 unit=""  /> 
+       <field id="TZOONH4"     long_name="TZOONH4"                                 unit=""  /> 
+       <field id="TZOODOM"     long_name="TZOODOM"                                 unit=""  /> 
+       <field id="TNH4NO3"     long_name="TNH4NO3"                                 unit=""  /> 
+       <field id="TDOMNH4"     long_name="TDOMNH4"                                 unit=""  /> 
+       <field id="TDETNH4"     long_name="TDETNH4"                                 unit=""  /> 
+       <field id="TPHYTOT"     long_name="TPHYTOT"                                 unit=""  /> 
+       <field id="TZOOTOT"     long_name="TZOOTOT"                                 unit=""  /> 
+       <field id="SEDPOC"      long_name="SEDPOC"                                  unit=""  /> 
+       <field id="TDETSED"     long_name="TDETSED"                                 unit=""  /> 
+
+       <!-- CFC11 : variables available with key_cfc -->
+       <field id="qtrCFC11"    long_name="Air-sea flux of CFC-11"                  unit="mol/m2/s"   />
+       <field id="qintCFC11"   long_name="Cumulative air-sea flux of CFC-11"       unit="mol/m2"     />
+
+       <!-- Bomb C14 : variables available with key_c14b -->
+       <field id="qtrC14b"     long_name="Air-sea flux of Bomb C14"                unit="mol/m2/s"   />
+       <field id="qintC14b"    long_name="Cumulative air-sea flux of Bomb C14"     unit="mol/m2"     />
+       <field id="fdecay"      long_name="Radiactive decay of Bomb C14"            unit="mol/m3"  grid_ref="grid_T_3D"  />
+
+       <!-- IDTRA : variables available with key_idtra -->
+       <field id="qtrIDTRA"    long_name="Air-sea flux of Ideal Tracer"             unit="mol/m2/s"   />
+       <field id="qintIDTRA"   long_name="Cumulative air-sea flux of Ideal Tracer"  unit="mol/m2"     />
+       <field id="invIDTRA"    long_name="Vertical inventory"                       unit="mol/m2"     />
+
+       <!-- MEDUSA additional diagnostics on T grid  -->
+       <field id= "INVTN"      long_name="Column N inventory"                        unit="mmolN/m2"    />
+       <field id= "INVTSI"     long_name="Column Si inventory"                       unit="mmolSi/m2"   />
+       <field id= "INVTFE"     long_name="Column Fe inventory"                       unit="mmolFe/m2"   />
+       <field id= "PRN"        long_name="Non-diatom primary production"             unit="mmolN/m2/d"  />
+       <field id= "MPN"        long_name="Non-diatom non-grazing losses"             unit="mmolN/m2/d"  />
+       <field id= "PRD"        long_name="Diatom primary production"                 unit="mmolN/m2/d"  />
+       <field id= "MPD"        long_name="Diatom non-grazing losses"                 unit="mmolN/m2/d"  />
+       <field id= "DSED"       long_name="Gravitational sinking of Detritus"         unit="mmolN/m2/d"  />
+       <field id= "OPAL"       long_name="Diatom biogenic opal production"           unit="mmolSi/m2/d" />
+       <field id= "OPALDISS"   long_name="Diatom biogenic opal dissolution"          unit="mmolSi/m2/d" />
+       <field id= "GMIPn"      long_name="Microzoo grazing on non-diatoms"           unit="mmolN/m2/d"  />
+       <field id= "GMID"       long_name="Microzoo grazing on detritus"              unit="mmolN/m2/d"  />
+       <field id= "MZMI"       long_name="Microzoo non-grazing losses"               unit="mmolN/m2/d"  />
+       <field id= "GMEPN"      long_name="Mesozoo grazing on non-diatoms"            unit="mmolN/m2/d"  />
+       <field id= "GMEPD"      long_name="Mesozoo grazing on non-diatoms"            unit="mmolN/m2/d"  />
+       <field id= "GMEZMI"     long_name="Mesozoo grazing on microzoo"               unit="mmolN/m2/d"  />
+       <field id= "GMED"       long_name="Mesozoo grazing on detritus"               unit="mmolN/m2/d"  />
+       <field id= "MZME"       long_name="Mesozoo non-grazing losses"                unit="mmolN/m2/d"  />
+       <field id= "DEXP"       long_name="Detritus export"                           unit="mmolN/m2/d"  />
+       <field id= "DETN"       long_name="Slow detritus creation"                    unit="mmolN/m2/d"  />
+       <field id= "MDET"       long_name="Detritus non-grazing losses"               unit="MmolN/m2/d"  />
+       <field id= "AEOLIAN"    long_name="Aeolian deposition of iron"                unit="mmolFe/m2/d" />
+       <field id= "BENTHIC"    long_name="Benthic supply of iron"                    unit="mmolFe/m2/d" />
+       <field id= "SCAVENGE"   long_name="Scavenged iron"                            unit="mmolFe/m2/d" />
+       <field id= "PN_JLIM"    long_name="Non-diatom light limitation"               unit="-"           />
+       <field id= "PN_NLIM"    long_name="Non-diatom N limitation"                   unit="-"           />
+       <field id= "PN_FELIM"   long_name="Non-diatom Fe limitation"                  unit="-"           />
+       <field id= "PD_JLIM"    long_name="Diatom light limitation"                   unit="-"           />
+       <field id= "PD_NLIM"    long_name="Diatom N limitation"                       unit="-"           />
+       <field id= "PD_FELIM"   long_name="Diatom Fe limitation"                      unit="-"           />
+       <field id= "PD_SILIM"   long_name="Diatom Si limitation"                      unit="-"           />
+       <field id= "PDSILIM2"   long_name="Diatom Si uptake limitation"               unit="-"           />
+       <field id= "SDT__100"   long_name="Slow detrital flux at  100 m"              unit="mmolN/m2/d"  />
+       <field id= "SDT__200"   long_name="Slow detrital flux at  200 m"              unit="mmolN/m2/d"  />
+       <field id= "SDT__500"   long_name="Slow detrital flux at  500 m"              unit="mmolN/m2/d"  />
+       <field id= "SDT_1000"   long_name="Slow detrital flux at 1000 m"              unit="mmolN/m2/d"  />
+       <field id= "TOTREG_N"   long_name="Full column regenerated N"                 unit="mmolN/m2/d"  />
+       <field id= "TOTRG_SI"   long_name="Full column regenerated Si"                unit="mmolSi/m2/d" />
+       <field id= "REG__100"   long_name="Regenerated N to  100 m"                   unit="mmolN/m2/d"  />
+       <field id= "REG__200"   long_name="Regenerated N to  200 m"                   unit="mmolN/m2/d"  />
+       <field id= "REG__500"   long_name="Regenerated N to  500 m"                   unit="mmolN/m2/d"  />
+       <field id= "REG_1000"   long_name="Regenerated N to 1000 m"                   unit="mmolN/m2/d"  />
+       <field id= "FASTN"      long_name="Fast-sinking flux N"                       unit="mmolN/m2/d"  />
+       <field id= "FASTSI"     long_name="Fast-sinking flux Si"                      unit="mmolSi/m2/d" />
+       <field id= "FASTFE"     long_name="Fast-sinking flux Fe"                      unit="mmolFe/m2/d" />
+       <field id= "FASTC"      long_name="Fast-sinking flux C"                       unit="mmolC/m2/d"  />
+       <field id= "FASTCA"     long_name="Fast-sinking flux CaCO3"                   unit="mmolC/m2/d"  />
+       <field id= "FDT__100"   long_name="Fast detrital N flux at  100 m"            unit="mmolN/m2/d"  />
+       <field id= "FDT__200"   long_name="Fast detrital N flux at  200 m"            unit="mmolN/m2/d"  />
+       <field id= "FDT__500"   long_name="Fast detrital N flux at  500 m"            unit="mmolN/m2/d"  />
+       <field id= "FDT_1000"   long_name="Fast detrital N flux at 1000 m"            unit="mmolN/m2/d"  />
+       <field id= "RG__100F"   long_name="Regenerated fast N to  100 m"              unit="mmolN/m2/d"  />
+       <field id= "RG__200F"   long_name="Regenerated fast N to  200 m"              unit="mmolN/m2/d"  />
+       <field id= "RG__500F"   long_name="Regenerated fast N to  500 m"              unit="mmolN/m2/d"  />
+       <field id= "RG_1000F"   long_name="Regenerated fast N to 1000 m"              unit="mmolN/m2/d"  />
+       <field id= "FDS__100"   long_name="Fast detrital Si flux at  100 m"           unit="mmolSi/m2/d" />
+       <field id= "FDS__200"   long_name="Fast detrital Si flux at  200 m"           unit="mmolSi/m2/d" />
+       <field id= "FDS__500"   long_name="Fast detrital Si flux at  500 m"           unit="mmolSi/m2/d" />
+       <field id= "FDS_1000"   long_name="Fast detrital Si flux at 1000 m"           unit="mmolSi/m2/d" />
+       <field id= "RGS_100F"   long_name="Regenerated fast Si to  100 m"             unit="mmolSi/m2/d" />
+       <field id= "RGS_200F"   long_name="Regenerated fast Si to  200 m"             unit="mmolSi/m2/d" />
+       <field id= "RGS_500F"   long_name="Regenerated fast Si to  500 m"             unit="mmolSi/m2/d" />
+       <field id= "RGS1000F"   long_name="Regenerated fast Si to 1000 m"             unit="mmolSi/m2/d" />
+       <field id= "REMINN"     long_name="Fast-sinking remin flux N"                 unit="mmolN/m2/d"  />
+       <field id= "REMINSI"    long_name="Fast-sinking remin flux Si"                unit="mmolSi/m2/d" />
+       <field id= "REMINFE"    long_name="Fast-sinking remin flux Fe"                unit="mmolFe/m2/d" />
+       <field id= "REMINC"     long_name="Fast-sinking remin flux C"                 unit="mmolC/m2/d"  />
+       <field id= "REMINCA"    long_name="Fast-sinking remin flux CaCO3"             unit="mmolC/m2/d"  />
+       <field id= "SEAFLRN"    long_name="Seafloor flux of N"                        unit="mmolN/m2/d"  />
+       <field id= "SEAFLRSI"   long_name="Seafloor flux of Si"                       unit="mmolSi/m2/d" />
+       <field id= "SEAFLRFE"   long_name="Seafloor flux of Fe"                       unit="mmolFe/m2/d" />
+       <field id= "SEAFLRC"    long_name="Seafloor flux of C"                        unit="mmolC/m2/d"  />
+       <field id= "SEAFLRCA"   long_name="Seafloor flux of CaCO3"                    unit="mmolC/m2/d"  />
+       <field id= "MED_QSR"    long_name="Sea surface radiation"                     unit="W/m2"        />
+       <field id= "MED_XPAR"   long_name="Top level radiation"                       unit="W/m2"        />
+       <field id= "INTFLX_N"   long_name="Integrated N  cycle fluxes"                unit="mmolN/m2/d"  />
+       <field id= "INTFLX_SI"  long_name="Integrated Si cycle fluxes"                unit="mmolSi/m2/d" />
+       <field id= "INTFLX_FE"  long_name="Integrated Fe cycle fluxes"                unit="mmolFe/m2/d" />
+       <field id= "INT_PN"     long_name="Vertically integrated Pn"                  unit="mmolN/m2"    />
+       <field id= "INT_PD"     long_name="Vertically integrated Pd"                  unit="mmolN/m2"    />
+       <field id= "ML_PRN"     long_name="Non-diatom mixed layer PP"                 unit="mmolN/m2/d"  />
+       <field id= "ML_PRD"     long_name="Diatom mixed layer PP"                     unit="mmolN/m2/d"  />
+       <field id= "OCAL_CCD"   long_name="Calcite CCD depth"                         unit="m"           />
+       <field id= "OCAL_LVL"   long_name="Calcite CCD level"                         unit="-"           />
+       <field id= "FE_0000"    long_name="Free iron at    0m"                        unit="-"           />
+       <field id= "FE_0100"    long_name="Free iron at  100m"                        unit="-"           />
+       <field id= "FE_0200"    long_name="Free iron at  200m"                        unit="-"           />
+       <field id= "FE_0500"    long_name="Free iron at  500m"                        unit="-"           />
+       <field id= "FE_1000"    long_name="Free iron at 1000m"                        unit="-"           />
+       <field id= "MED_XZE"    long_name="Euphotic depth"                            unit="m"           />
+       <field id= "WIND"       long_name="Surface scalar wind"                       unit="m/s"         />
+       <field id= "ATM_PCO2"   long_name="Atmospheric pCO2"                          unit="ppmv"        />
+       <field id= "OCN_PH"     long_name="Surface ocean pH"                          unit="-"           />
+       <field id= "OCN_PCO2"   long_name="Surface ocean pCO2"                        unit="ppmv"        />
+       <field id= "OCNH2CO3"   long_name="Surface ocean H2CO3 conc"                  unit="mmolC/m3"    />
+       <field id= "OCN_HCO3"   long_name="Surface ocean HCO3 conc"                   unit="mmolC/m3"    />
+       <field id= "OCN_CO3"    long_name="Surface ocean CO3 conc"                    unit="mmolC/m3"    />
+       <field id= "CO2FLUX"    long_name="Air-sea CO2 flux"                          unit="mmolC/m2/d"  />
+       <field id= "OM_CAL"     long_name="Omega calcite"                             unit="-"           />
+       <field id= "OM_ARG"     long_name="Omega aragonite"                           unit="-"           />
+       <field id= "TCO2"       long_name="Total CO2"                                 unit="umol/kg"     />
+       <field id= "TALK"       long_name="Total alkalinity"                          unit="ueq/kg"      />
+       <field id= "KW660"      long_name="Piston velocity"                           unit="m/s"         />
+       <field id= "ATM_PP0"    long_name="Atmospheric pressure"                      unit="bar"         />
+       <field id= "O2FLUX"     long_name="Air-sea O2 flux"                           unit="mmolO2/m2/d" />
+       <field id= "O2SAT"      long_name="Surface ocean O2 saturation"               unit="mmolO2/m3"   />
+       <field id= "CAL_CCD"    long_name="Calcite CCD depth"                         unit="m"           />
+       <field id= "ARG_CCD"    long_name="Aragonite CCD depth"                       unit="m"           />
+       <field id= "SFR_OCAL"   long_name="Seafloor omega calcite"                    unit="-"           />
+       <field id= "SFR_OARG"   long_name="Seafloor omega aragonite"                  unit="-"           />
+       <field id= "N_PROD"     long_name="Nitrogen production"                       unit="mmolN/m2/d"  />
+       <field id= "N_CONS"     long_name="Nitrogen consumption"                      unit="mmolN/m2/d"  />
+       <field id= "C_PROD"     long_name="Carbon production"                         unit="mmolC/m2/d"  />
+       <field id= "C_CONS"     long_name="Carbon consumption"                        unit="mmolC/m2/d"  />
+       <field id= "O2_PROD"    long_name="Oxygen production"                         unit="mmolO2/m2/d" />
+       <field id= "O2_CONS"    long_name="Oxygen consumption"                        unit="mmolO2/m2/d" />
+       <field id= "O2_ANOX"    long_name="Unrealised oxygen consumption"             unit="mmolO2/m2/d" />
+       <field id= "RR_0100"    long_name="Rain ratio at  100m"                       unit="molC/molC"   />
+       <field id= "RR_0500"    long_name="Rain ratio at  500m"                       unit="molC/molC"   />
+       <field id= "RR_1000"    long_name="Rain ratio at 1000m"                       unit="molC/molC"   />
+       <field id= "IBEN_N"     long_name="Benthic input nitrogen"                    unit="mmolN/m2/d"  />
+       <field id= "IBEN_FE"    long_name="Benthic input iron"                        unit="mmolFe/m2/d" />
+       <field id= "IBEN_C"     long_name="Benthic input carbon"                      unit="mmolC/m2/d"  />
+       <field id= "IBEN_SI"    long_name="Benthic input silicon"                     unit="mmolSi/m2/d" />
+       <field id= "IBEN_CA"    long_name="Benthic input CaCO3"                       unit="mmolC/m2/d"  />
+       <field id= "OBEN_N"     long_name="Benthic output nitrogen"                   unit="mmolN/m2/d"  />
+       <field id= "OBEN_FE"    long_name="Benthic output iron"                       unit="mmolFe/m2/d" />
+       <field id= "OBEN_C"     long_name="Benthic output carbon"                     unit="mmolC/m2/d"  />
+       <field id= "OBEN_SI"    long_name="Benthic output silicon"                    unit="mmolSi/m2/d" />
+       <field id= "OBEN_CA"    long_name="Benthic output CaCO3"                      unit="mmolC/m2/d"  />
+       <field id= "BEN_N"      long_name="Benthic nitrogen"                          unit="mmolN/m2"    />
+       <field id= "BEN_FE"     long_name="Benthic iron"                              unit="mmolFe/m2"   />
+       <field id= "BEN_C"      long_name="Benthic carbon"                            unit="mmolC/m2"    />
+       <field id= "BEN_SI"     long_name="Benthic silicon"                           unit="mmolSi/m2"   />
+       <field id= "BEN_CA"     long_name="Benthic CaCO3"                             unit="mmolC/m2"    />
+       <field id= "RUNOFF"     long_name="River runoff"                              unit="m/d"         />
+       <field id= "RIV_N"      long_name="Riverine input nitrogen"                   unit="mmolN/m2/d"  />
+       <field id= "RIV_SI"     long_name="Riverine input silicon"                    unit="mmolSi/m2/d" />
+       <field id= "RIV_C"      long_name="Riverine input carbon"                     unit="mmolSi/m2/d" />
+       <field id= "RIV_ALK"    long_name="Riverine input alkalinity"                 unit="meq/m2/d"    />
+       <field id= "DETC"       long_name="Slow detritus C creation"                  unit="mmolC/m2/d"  />
+       <field id= "SDC__100"   long_name="Slow detrital C flux at  100 m"            unit="mmolC/m2/d"  />
+       <field id= "SDC__200"   long_name="Slow detrital C flux at  200 m"            unit="mmolC/m2/d"  />
+       <field id= "SDC__500"   long_name="Slow detrital C flux at  500 m"            unit="mmolC/m2/d"  />
+       <field id= "SDC_1000"   long_name="Slow detrital C flux at 1000 m"            unit="mmolC/m2/d"  />
+       <field id= "INVTC"      long_name="Column C inventory"                        unit="mmolC/m2"    />
+       <field id= "INVTALK"    long_name="Column alkalinity inventory"               unit="meq/m2"      />
+       <field id= "INVTO2"     long_name="Column O2 inventory"                       unit="mmolO2/m2"   />
+       <field id= "LYSO_CA"    long_name="Incorrect benthic output CaCO3"            unit="mmolC/m2/d"  />
+       <field id= "COM_RESP"   long_name="Community respiration"                     unit="mmolC/m2/d"  />
+       <field id= "PN_LLOSS"   long_name="Non-diatom linear losses"                  unit="mmolN/m2/d"  />
+       <field id= "PD_LLOSS"   long_name="Diatom linear losses"                      unit="mmolN/m2/d"  />
+       <field id= "ZI_LLOSS"   long_name="Microzooplankton linear losses"            unit="mmolN/m2/d"  />
+       <field id= "ZE_LLOSS"   long_name="Mesozooplankton linear losses"             unit="mmolN/m2/d"  />
+       <field id= "ZI_MES_N"   long_name="Microzoo messy feeding loss to N"          unit="mmolN/m2/d"  />
+       <field id= "ZI_MES_D"   long_name="Microzoo messy feeding loss to D"          unit="mmolN/m2/d"  />
+       <field id= "ZI_MES_C"   long_name="Microzoo messy feeding loss to C"          unit="mmolC/m2/d"  />
+       <field id= "ZI_MESDC"   long_name="Microzoo messy feeding loss to Dc"         unit="mmolC/m2/d"  />
+       <field id= "ZI_EXCR"    long_name="Microzoo excretion"                        unit="mmolN/m2/d"  />
+       <field id= "ZI_RESP"    long_name="Microzoo respiration"                      unit="mmolC/m2/d"  />
+       <field id= "ZI_GROW"    long_name="Microzoo growth"                           unit="mmolN/m2/d"  />
+       <field id= "ZE_MES_N"   long_name="Mesozoo messy feeding loss to N"           unit="mmolN/m2/d"  />
+       <field id= "ZE_MES_D"   long_name="Mesozoo messy feeding loss to D"           unit="mmolN/m2/d"  />
+       <field id= "ZE_MES_C"   long_name="Mesozoo messy feeding loss to C"           unit="mmolC/m2/d"  />
+       <field id= "ZE_MESDC"   long_name="Mesozoo messy feeding loss to Dc"          unit="mmolC/m2/d"  />
+       <field id= "ZE_EXCR"    long_name="Mesozoo excretion"                         unit="mmolN/m2/d"  />
+       <field id= "ZE_RESP"    long_name="Mesozoo respiration"                       unit="mmolC/m2/d"  />
+       <field id= "ZE_GROW"    long_name="Mesozoo growth"                            unit="mmolN/m2/d"  />
+       <field id= "MDETC"      long_name="Detritus non-grazing losses, carbon"       unit="mmolC/m2/d"  />
+       <field id= "GMIDC"      long_name="Microzoo grazing on detritus, carbon"      unit="mmolC/m2/d"  />
+       <field id= "GMEDC"      long_name="Mesozoo  grazing on detritus, carbon"      unit="mmolC/m2/d"  />
+       <field id= "INT_ZMI"    long_name="Vertically integrated Zmi"                 unit="mmolN/m2"    />
+       <field id= "INT_ZME"    long_name="Vertically integrated Zme"                 unit="mmolN/m2"    />
+       <field id= "INT_DET"    long_name="Vertically integrated Det"                 unit="mmolN/m2"    />
+       <field id= "INT_DTC"    long_name="Vertically integrated Dtc"                 unit="mmolC/m2"    />
+       <field id= "DMS_SURF"   long_name="DMS Surface Concentration"                 unit="nmol/L"      />
+       <field id= "DMS_ANDR"   long_name="DMS Surface Concentration, Anderson"       unit="nmol/L"      />
+       <field id= "DMS_SIMO"   long_name="DMS Surface Concentration, SimoDach"       unit="nmol/L"      />
+       <field id= "DMS_ARAN"   long_name="DMS Surface Concentration, AranamiT"       unit="nmol/L"      />
+       <field id= "DMS_HALL"   long_name="DMS Surface Concentration, Halloran"       unit="nmol/L"      />
+
+       <!-- AXY (08/11/16): add new 2D CMIP6 diagnostics -->
+       <field id= "epC100"     long_name="Downward Flux of Particle Organic Carbon"  unit="mmolC/m2/d"  />
+       <field id= "epCALC100"  long_name="Downward Flux of Calcite"                  unit="mmolC/m2/d"  />
+       <field id= "epN100"     long_name="Downward Flux of Particulate Nitrogen"     unit="mmolN/m2/d"  />
+       <field id= "epSI100"    long_name="Downward Flux of Particulate Silica"       unit="mmolSi/m2/d" />
+       <field id= "FGCO2"      long_name="Surface Downward CO2 Flux"                 unit="kg/m2/s"     />
+       <field id= "INTDISSIC"  long_name="Dissolved Inorganic Carbon Content"        unit="mmolC/m2"    />
+       <field id= "INTDISSIN"  long_name="Dissolved Inorganic Nitrogen Content"      unit="mmolN/m2"    />
+       <field id= "INTDISSISI" long_name="Dissolved Inorganic Silicon Content"       unit="mmolSi/m2"   />
+       <field id= "INTALK"     long_name="Dissolved Alkalinity Content"              unit="meq/m2"      />
+       <field id= "O2min"      long_name="Oxygen Minimum Concentration"              unit="mmolO2/m3"   />
+       <field id= "ZO2min"     long_name="Depth of Oxygen Minimum Concentration"     unit="m"           />
+
+       <field id= "TPP3"       long_name="Total primary production 3D"               unit="mmolN/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "DETFLUX3"   long_name="Total detrital flux 3D"                    unit="mmolN/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "REMIN3N"    long_name="Total remin flux N 3D"                     unit="mmolN/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "PH3"        long_name="Ocean pH 3D"                               unit="-"             grid_ref="grid_T_3D"  />
+       <field id= "OM_CAL3"    long_name="Omega calcite 3D"                          unit="-"             grid_ref="grid_T_3D"  />
+
+       <!-- AXY (08/11/16): add new 3D CMIP6 diagnostics -->
+       <field id= "TPPD3"      long_name="Diatom primary production 3D"              unit="mmolN/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "BDDTALK3"   long_name="Change of Alkalinity due to Biology"       unit="meq/m3/d"      grid_ref="grid_T_3D"  />
+       <field id= "BDDTDIC3"   long_name="Change of DI Carbon due to Biology"        unit="mmolC/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "BDDTIFE3"   long_name="Change of DI Iron due to Biology"          unit="mmolFe/m3/d"   grid_ref="grid_T_3D"  />
+       <field id= "BDDTDIN3"   long_name="Change of DI Nitrogen due to Biology"      unit="mmolN/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "BDDTDISI3"  long_name="Change of DI Silicon due to Biology"       unit="mmolSi/m3/d"   grid_ref="grid_T_3D"  />
+       <field id= "FD_NIT3"    long_name="Fast sinking detrital nitrogen"            unit="mmolN/m2/d"    grid_ref="grid_T_3D"  />
+       <field id= "FD_SIL3"    long_name="Fast sinking detrital silicon"             unit="mmolSi/m2/d"   grid_ref="grid_T_3D"  />
+       <field id= "FD_CAR3"    long_name="Fast sinking detrital carbon"              unit="mmolC/m2/d"    grid_ref="grid_T_3D"  />
+       <field id= "FD_CAL3"    long_name="Fast sinking detrital calcium carbonate"   unit="mmolC/m2/d"    grid_ref="grid_T_3D"  />
+       <field id= "CO33"       long_name="Carbonate ion concentration"               unit="mmolC/m3"      grid_ref="grid_T_3D"  />
+       <field id= "CO3SATARG3" long_name="Carbonate aragonite saturation conc"       unit="mmolC/m3"      grid_ref="grid_T_3D"  />
+       <field id= "CO3SATCAL3" long_name="Carbonate calcite saturation conc"         unit="mmolC/m3"      grid_ref="grid_T_3D"  />
+       <field id= "DCALC3"     long_name="Calcite dissolution"                       unit="mmolC/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "EXPC3"      long_name="Downward Flux of Particulate Org Carbon"   unit="mmolC/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "EXPN3"      long_name="Downward Flux of Particulate Org Nitrogen" unit="mmolN/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "FEDISS3"    long_name="Particle Source of Dissolved Iron"         unit="mmolFe/m3/d"   grid_ref="grid_T_3D"  />
+       <field id= "FESCAV3"    long_name="Nonbiogenic Iron Scavenging"               unit="mmolFe/m3/d"   grid_ref="grid_T_3D"  />
+       <field id= "MIGRAZP3"   long_name="Microzooplankton grazing on phytoplankton" unit="mmolC/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "MIGRAZD3"   long_name="Microzooplankton grazing on detritus"      unit="mmolC/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "MEGRAZP3"   long_name="Mesozooplankton grazing on phytoplankton"  unit="mmolC/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "MEGRAZD3"   long_name="Mesozooplankton grazing on detritus"       unit="mmolC/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "MEGRAZZ3"   long_name="Mesozooplankton grazing on microzoop"      unit="mmolC/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "O2SAT3"     long_name="Dissolved Oxygen Saturation Concentration" unit="mmolO2/m3"     grid_ref="grid_T_3D"  />
+       <field id= "PBSI3"      long_name="Biogenic Silica Production"                unit="mmolSi/m3/d"   grid_ref="grid_T_3D"  />
+       <field id= "PCAL3"      long_name="Biogenic Calcite Production"               unit="mmolC/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "REMOC3"     long_name="Remineralization of Organic Carbon"        unit="mmolC/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "PNLIMJ3"    long_name="Irradiance limitation of non-diatoms"      unit="-"             grid_ref="grid_T_3D"  />
+       <field id= "PNLIMN3"    long_name="Nitrogen limitation of non-diatoms"        unit="-"             grid_ref="grid_T_3D"  />
+       <field id= "PNLIMFE3"   long_name="Iron limitation of non-diatoms"            unit="-"             grid_ref="grid_T_3D"  />
+       <field id= "PDLIMJ3"    long_name="Irradiance limitation of diatoms"          unit="-"             grid_ref="grid_T_3D"  />
+       <field id= "PDLIMN3"    long_name="Nitrogen limitation of diatoms"            unit="-"             grid_ref="grid_T_3D"  />
+       <field id= "PDLIMFE3"   long_name="Iron limitation of diatoms"                unit="-"             grid_ref="grid_T_3D"  />
+       <field id= "PDLIMSI3"   long_name="Silicon limitation of diatoms"             unit="-"             grid_ref="grid_T_3D"  />
+
+     </field_group>
+
+     <field_group id="PISCES_scalar"  domain_ref="1point" >
+       <field id="pno3tot"         long_name="global mean nitrate concentration"                  unit="mol/m3"   />
+       <field id="ppo4tot"         long_name="global mean phosphorus concentration"               unit="mol/m3"   />
+       <field id="psiltot"         long_name="global mean silicate concentration"                 unit="mol/m3"   />
+       <field id="palktot"         long_name="global mean alkalinity concentration"               unit="mol/m3"   />
+       <field id="pfertot"         long_name="global mean iron concentration"                     unit="mol/m3"   />
+       <field id="tcflx"           long_name="total Flux of Carbon out of the ocean"              unit="mol/s"   />
+       <field id="tcflxcum"        long_name="cumulative total Flux of Carbon out of the ocean"   unit="mol/s"   />
+       <field id="tcexp"           long_name="total Carbon export at 100m"                        unit="mol/s"   />
+       <field id="tintpp"          long_name="global total integrated primary production"         unit="mol/s"   />
+       <field id="tnfix"           long_name="global total nitrogen fixation"                     unit="mol/s"   />
+       <field id="tdenit"          long_name="Total denitrification"                              unit="mol/s"   />
+     </field_group>
+
+    <!-- 
+============================================================================================================
+                                        Definitions for iodef_demo.xml
+============================================================================================================
+    -->
+
+    <field_group id="groupMEDUSA" >
+      <field field_ref="CHN"   name="CHN"   />
+      <field field_ref="CHD"   name="CHD"   />
+      <field field_ref="PHN"   name="PHN"   />
+      <field field_ref="PHD"   name="PHD"   />
+      <field field_ref="ZMI"   name="ZMI"   />
+      <field field_ref="ZME"   name="ZME"   />
+      <field field_ref="DIN"   name="DIN"   />
+      <field field_ref="SIL"   name="SIL"   />
+      <field field_ref="FER"   name="FER"   />
+      <field field_ref="DET"   name="DET"   />
+      <field field_ref="PDS"   name="PDS"   />
+      <field field_ref="DTC"   name="DTC"   />
+      <field field_ref="DiC"   name="DIC"   />
+      <field field_ref="ALK"   name="ALK"   />
+      <field field_ref="OXY"   name="OXY"   />
+      </field_group>
+
+    <field_group id="groupIDTRA" >
+      <field field_ref="IDTRA" name="IDTRA" />
+    </field_group>
+
+    <field_group id="groupIDTRA_dia" >
+      <field field_ref="qtrIDTRA"    name="qtrIDTRA"  />
+      <field field_ref="qintIDTRA"   name="qintIDTRA" />
+      <field field_ref="invIDTRA"    name="invIDTRA"  />
+    </field_group>
+
+    <field_group id="groupCFC" >
+      <field field_ref="CFC11" name="CFC11" />
+    </field_group>
+
+    <field_group id="groupCFC_dia" >
+      <field field_ref="qtrCFC11"    name="qtrCFC11"   />
+      <field field_ref="qintCFC11"   name="qintCFC11"  />
+    </field_group>
+
+    <field_group id="groupAGE" >
+      <field field_ref="Age" name="Age" />
+    </field_group>
+
+    <field_group id="groupMEDUSA_dia" >
+      <field field_ref= "INVTN"      name="INVTN"      />
+      <field field_ref= "INVTSI"     name="INVTSI"     />
+      <field field_ref= "INVTFE"     name="INVTFE"     />
+      <field field_ref= "PRN"        name="PRN"        />
+      <field field_ref= "MPN"        name="MPN"        />
+      <field field_ref= "PRD"        name="PRD"        />
+      <field field_ref= "MPD"        name="MPD"        />
+      <field field_ref= "OPAL"       name="OPAL"       />
+      <field field_ref= "OPALDISS"   name="OPALDISS"   />
+      <field field_ref= "GMIPn"      name="GMIPn"      />
+      <field field_ref= "GMID"       name="GMID"       />
+      <field field_ref= "MZMI"       name="MZMI"       />
+      <field field_ref= "GMEPN"      name="GMEPN"      />
+      <field field_ref= "GMEPD"      name="GMEPD"      />
+      <field field_ref= "GMEZMI"     name="GMEZMI"     />
+      <field field_ref= "GMED"       name="GMED"       />
+      <field field_ref= "MZME"       name="MZME"       />
+      <field field_ref= "DETN"       name="DETN"       />
+      <field field_ref= "MDET"       name="MDET"       />
+      <field field_ref= "AEOLIAN"    name="AEOLIAN"    />
+      <field field_ref= "BENTHIC"    name="BENTHIC"    />
+      <field field_ref= "SCAVENGE"   name="SCAVENGE"   />
+      <field field_ref= "PN_JLIM"    name="PN_JLIM"    />
+      <field field_ref= "PN_NLIM"    name="PN_NLIM"    />
+      <field field_ref= "PN_FELIM"   name="PN_FELIM"   />
+      <field field_ref= "PD_JLIM"    name="PD_JLIM"    />
+      <field field_ref= "PD_NLIM"    name="PD_NLIM"    />
+      <field field_ref= "PD_FELIM"   name="PD_FELIM"   />
+      <field field_ref= "PD_SILIM"   name="PD_SILIM"   />
+      <field field_ref= "PDSILIM2"   name="PDSILIM2"   />
+      <field field_ref= "SDT__100"   name="SDT__100"   />
+      <field field_ref= "SDT__200"   name="SDT__200"   />
+      <field field_ref= "SDT__500"   name="SDT__500"   />
+      <field field_ref= "SDT_1000"   name="SDT_1000"   />
+      <field field_ref= "TOTREG_N"   name="TOTREG_N"   />
+      <field field_ref= "TOTRG_SI"   name="TOTRG_SI"   />
+      <field field_ref= "REG__100"   name="REG__100"   />
+      <field field_ref= "REG__200"   name="REG__200"   />
+      <field field_ref= "REG__500"   name="REG__500"   />
+      <field field_ref= "REG_1000"   name="REG_1000"   />
+      <field field_ref= "FASTN"      name="FASTN"      />
+      <field field_ref= "FASTSI"     name="FASTSI"     />
+      <field field_ref= "FASTFE"     name="FASTFE"     />
+      <field field_ref= "FASTC"      name="FASTC"      />
+      <field field_ref= "FASTCA"     name="FASTCA"     />
+      <field field_ref= "FDT__100"   name="FDT__100"   />
+      <field field_ref= "FDT__200"   name="FDT__200"   />
+      <field field_ref= "FDT__500"   name="FDT__500"   />
+      <field field_ref= "FDT_1000"   name="FDT_1000"   /> 
+      <field field_ref= "RG__100F"   name="RG__100F"   />
+      <field field_ref= "RG__200F"   name="RG__200F"   />
+      <field field_ref= "RG__500F"   name="RG__500F"   />
+      <field field_ref= "RG_1000F"   name="RG_1000F"   />
+      <field field_ref= "FDS__100"   name="FDS__100"   />
+      <field field_ref= "FDS__200"   name="FDS__200"   />
+      <field field_ref= "FDS__500"   name="FDS__500"   />
+      <field field_ref= "FDS_1000"   name="FDS_1000"   />
+      <field field_ref= "RGS_100F"   name="RGS_100F"   />
+      <field field_ref= "RGS_200F"   name="RGS_200F"   />
+      <field field_ref= "RGS_500F"   name="RGS_500F"   />
+      <field field_ref= "RGS1000F"   name="RGS1000F"   />
+      <field field_ref= "REMINN"     name="REMINN"     />
+      <field field_ref= "REMINSI"    name="REMINSI"    />
+      <field field_ref= "REMINFE"    name="REMINFE"    />
+      <field field_ref= "SEAFLRN"    name="SEAFLRN"    /> 
+      <field field_ref= "SEAFLRSI"   name="SEAFLRSI"   />
+      <field field_ref= "SEAFLRFE"   name="SEAFLRFE"   />
+      <field field_ref= "SEAFLRC"    name="SEAFLRC"    />
+      <field field_ref= "SEAFLRCA"   name="SEAFLRCA"   />
+      <field field_ref= "MED_QSR"    name="MED_QSR"    />
+      <field field_ref= "MED_XPAR"   name="MED_XPAR"   />
+      <field field_ref= "INTFLX_N"   name="INTFLX_N"   />
+      <field field_ref= "INTFLX_SI"  name="INTFLX_SI"  />
+      <field field_ref= "INTFLX_FE"  name="INTFLX_FE"  />
+      <field field_ref= "INT_PN"     name="INT_PN"     />
+      <field field_ref= "INT_PD"     name="INT_PD"     />
+      <field field_ref= "ML_PRN"     name="ML_PRN"     />
+      <field field_ref= "ML_PRD"     name="ML_PRD"     />
+      <field field_ref= "OCAL_CCD"   name="OCAL_CCD"   />
+      <field field_ref= "OCAL_LVL"   name="OCAL_LVL"   />
+      <field field_ref= "FE_0000"    name="FE_0000"    />
+      <field field_ref= "FE_0100"    name="FE_0100"    />
+      <field field_ref= "FE_0200"    name="FE_0200"    /> 
+      <field field_ref= "FE_0500"    name="FE_0500"    />
+      <field field_ref= "FE_1000"    name="FE_1000"    />
+      <field field_ref= "MED_XZE"    name="MED_XZE"    />
+      <field field_ref= "WIND"       name="WIND"       />
+      <field field_ref= "ATM_PCO2"   name="ATM_PCO2"   />
+      <field field_ref= "OCN_PH"     name="OCN_PH"     />
+      <field field_ref= "OCN_PCO2"   name="OCN_PCO2"   />
+      <field field_ref= "OCNH2CO3"   name="OCNH2CO3"   />
+      <field field_ref= "OCN_HCO3"   name="OCN_HCO3"   />
+      <field field_ref= "OCN_CO3"    name="OCN_CO3"    />
+      <field field_ref= "CO2FLUX"    name="CO2FLUX"    />
+      <field field_ref= "OM_CAL"     name="OM_CAL"     />
+      <field field_ref= "OM_ARG"     name="OM_ARG"     />
+      <field field_ref= "TCO2"       name="TCO2"       />
+      <field field_ref= "TALK"       name="TALK"       />
+      <field field_ref= "KW660"      name="KW660"      />
+      <field field_ref= "ATM_PP0"    name="ATM_PP0"    />
+      <field field_ref= "O2FLUX"     name="O2FLUX"     />
+      <field field_ref= "O2SAT"      name="O2SAT"      />
+      <field field_ref= "CAL_CCD"    name="CAL_CCD"    />
+      <field field_ref= "ARG_CCD"    name="ARG_CCD"    />
+      <field field_ref= "SFR_OCAL"   name="SFR_OCAL"   />
+      <field field_ref= "SFR_OARG"   name="SFR_OARG"   />
+      <field field_ref= "N_PROD"     name="N_PROD"     />
+      <field field_ref= "N_CONS"     name="N_CONS"     />
+      <field field_ref= "C_PROD"     name="C_PROD"     />
+      <field field_ref= "C_CONS"     name="C_CONS"     />
+      <field field_ref= "O2_PROD"    name="O2_PROD"    />
+      <field field_ref= "O2_CONS"    name="O2_CONS"    />
+      <field field_ref= "O2_ANOX"    name="O2_ANOX"    />
+      <field field_ref= "RR_0100"    name="RR_0100"    />
+      <field field_ref= "RR_0500"    name="RR_0500"    />
+      <field field_ref= "RR_1000"    name="RR_1000"    />
+      <field field_ref= "IBEN_N"     name="IBEN_N"     />
+      <field field_ref= "IBEN_FE"    name="IBEN_FE"    />
+      <field field_ref= "IBEN_C"     name="IBEN_C"     />
+      <field field_ref= "IBEN_SI"    name="IBEN_SI"    />
+      <field field_ref= "IBEN_CA"    name="IBEN_CA"    />
+      <field field_ref= "OBEN_N"     name="OBEN_N"     />
+      <field field_ref= "OBEN_FE"    name="OBEN_FE"    />
+      <field field_ref= "OBEN_C"     name="OBEN_C"     />
+      <field field_ref= "OBEN_SI"    name="OBEN_SI"    />
+      <field field_ref= "OBEN_CA"    name="OBEN_CA"    />
+      <field field_ref= "BEN_N"      name="BEN_N"      />
+      <field field_ref= "BEN_FE"     name="BEN_FE"     />
+      <field field_ref= "BEN_C"      name="BEN_C"      />
+      <field field_ref= "BEN_SI"     name="BEN_SI"     />
+      <field field_ref= "BEN_CA"     name="BEN_CA"     />
+      <field field_ref= "DETC"       name="DETC"       />
+      <field field_ref= "SDC__100"   name="SDC__100"   />
+      <field field_ref= "SDC__200"   name="SDC__200"   />
+      <field field_ref= "SDC__500"   name="SDC__500"   />
+      <field field_ref= "SDC_1000"   name="SDC_1000"   />
+      <field field_ref= "INVTC"      name="INVTC"      />
+      <field field_ref= "INVTALK"    name="INVTALK"    />
+      <field field_ref= "INVTO2"     name="INVTO2"     />
+      <field field_ref= "LYSO_CA"    name="LYSO_CA"    />
+      <field field_ref= "COM_RESP"   name="COM_RESP"   />
+      <field field_ref= "PN_LLOSS"   name="PN_LLOSS"   />
+      <field field_ref= "PD_LLOSS"   name="PD_LLOSS"   />
+      <field field_ref= "ZI_LLOSS"   name="ZI_LLOSS"   />
+      <field field_ref= "ZE_LLOSS"   name="ZE_LLOSS"   />
+      <field field_ref= "ZI_MES_N"   name="ZI_MES_N"   />
+      <field field_ref= "ZI_MES_D"   name="ZI_MES_D"   />
+      <field field_ref= "ZI_MES_C"   name="ZI_MES_C"   />
+      <field field_ref= "ZI_MESDC"   name="ZI_MESDC"   />
+      <field field_ref= "ZI_EXCR"    name="ZI_EXCR"    />
+      <field field_ref= "ZI_RESP"    name="ZI_RESP"    />
+      <field field_ref= "ZI_GROW"    name="ZI_GROW"    />
+      <field field_ref= "ZE_MES_N"   name="ZE_MES_N"   />
+      <field field_ref= "ZE_MES_D"   name="ZE_MES_D"   />
+      <field field_ref= "ZE_MES_C"   name="ZE_MES_C"   />
+      <field field_ref= "ZE_MESDC"   name="ZE_MESDC"   />
+      <field field_ref= "ZE_EXCR"    name="ZE_EXCR"    />
+      <field field_ref= "ZE_RESP"    name="ZE_RESP"    />
+      <field field_ref= "ZE_GROW"    name="ZE_GROW"    />
+      <field field_ref= "MDETC"      name="MDETC"      />
+      <field field_ref= "GMIDC"      name="GMIDC"      />
+      <field field_ref= "GMEDC"      name="GMEDC"      />
+      <field field_ref= "INT_ZMI"    name="INT_ZMI"    />
+      <field field_ref= "INT_ZME"    name="INT_ZME"    />
+      <field field_ref= "INT_DET"    name="INT_DET"    />
+      <field field_ref= "INT_DTC"    name="INT_DTC"    />
+    </field_group>
+
+    <field_group id="groupMEDUSA_3dd" >
+      <field field_ref= "TPP3"       name="TPP3"       />
+      <field field_ref= "DETFLUX3"   name="DETFLUX3"   />
+      <field field_ref= "REMIN3N"    name="REMIN3N"    />
+      <field field_ref= "PH3"        name="PH3"        />
+      <field field_ref= "OM_CAL3"    name="OM_CAL3"    /> 
+    </field_group>
+
+    <field_group id="groupMEDUSA_dms" >
+      <field field_ref= "DMS_SURF"   name="DMS_SURF"   />
+      <field field_ref= "DMS_ANDR"   name="DMS_ANDR"   />
+      <field field_ref= "DMS_SIMO"   name="DMS_SIMO"   />
+      <field field_ref= "DMS_ARAN"   name="DMS_ARAN"   />
+      <field field_ref= "DMS_HALL"   name="DMS_HALL"   />
+    </field_group>
+
+    <field_group id="groupMEDUSA_riv" >
+      <field field_ref= "RUNOFF"     name="RUNOFF"     />
+      <field field_ref= "RIV_N"      name="RIV_N"      />
+      <field field_ref= "RIV_SI"     name="RIV_SI"     />
+      <field field_ref= "RIV_C"      name="RIV_C"      />
+      <field field_ref= "RIV_ALK"    name="RIV_ALK"    />
+    </field_group>
+
+    <field_group id="groupMEDUSA_cmip6" >
+      <field field_ref= "epC100"     name="epC100"     />
+      <field field_ref= "epCALC100"  name="epCALC100"  />
+      <field field_ref= "epN100"     name="epN100"     />
+      <field field_ref= "epSI100"    name="epSI100"    />
+      <field field_ref= "FGCO2"      name="FGCO2"      />
+      <field field_ref= "INTDISSIC"  name="INTDISSIC"  />
+      <field field_ref= "INTDISSIN"  name="INTDISSIN"  />
+      <field field_ref= "INTDISSISI" name="INTDISSISI" />
+      <field field_ref= "INTALK"     name="INTALK"     />
+      <field field_ref= "O2min"      name="O2min"      />
+      <field field_ref= "ZO2min"     name="ZO2min"     />
+      <field field_ref= "TPPD3"      name="TPPD3"      />
+      <field field_ref= "BDDTALK3"   name="BDDTALK3"   />
+      <field field_ref= "BDDTDIC3"   name="BDDTDIC3"   />
+      <field field_ref= "BDDTIFE3"   name="BDDTIFE3"   />
+      <field field_ref= "BDDTDIN3"   name="BDDTDIN3"   />
+      <field field_ref= "BDDTDISI3"  name="BDDTDISI3"  />
+      <field field_ref= "FD_NIT3"    name="FD_NIT3"    />
+      <field field_ref= "FD_SIL3"    name="FD_SIL3"    />
+      <field field_ref= "FD_CAR3"    name="FD_CAR3"    />
+      <field field_ref= "FD_CAL3"    name="FD_CAL3"    />
+      <field field_ref= "CO33"       name="CO33"       />
+      <field field_ref= "CO3SATARG3" name="CO3SATARG3" />
+      <field field_ref= "CO3SATCAL3" name="CO3SATCAL3" />
+      <field field_ref= "DCALC3"     name="DCALC3"     />
+      <field field_ref= "EXPC3"      name="EXPC3"      />
+      <field field_ref= "EXPN3"      name="EXPN3"      />
+      <field field_ref= "FEDISS3"    name="FEDISS3"    />
+      <field field_ref= "FESCAV3"    name="FESCAV3"    />
+      <field field_ref= "MIGRAZP3"   name="MIGRAZP3"   />
+      <field field_ref= "MIGRAZD3"   name="MIGRAZD3"   />
+      <field field_ref= "MEGRAZP3"   name="MEGRAZP3"   />
+      <field field_ref= "MEGRAZD3"   name="MEGRAZD3"   />
+      <field field_ref= "MEGRAZZ3"   name="MEGRAZZ3"   />
+      <field field_ref= "O2SAT3"     name="O2SAT3"     />
+      <field field_ref= "PBSI3"      name="PBSI3"      />
+      <field field_ref= "PCAL3"      name="PCAL3"      />
+      <field field_ref= "REMOC3"     name="REMOC3"     />
+      <field field_ref= "PNLIMJ3"    name="PNLIMJ3"    />
+      <field field_ref= "PNLIMN3"    name="PNLIMN3"    />
+      <field field_ref= "PNLIMFE3"   name="PNLIMFE3"   />
+      <field field_ref= "PDLIMJ3"    name="PDLIMJ3"    />
+      <field field_ref= "PDLIMN3"    name="PDLIMN3"    />
+      <field field_ref= "PDLIMFE3"   name="PDLIMFE3"   />
+      <field field_ref= "PDLIMSI3"   name="PDLIMSI3"   />
+    </field_group>
+
+</field_definition>
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/XIOS2/iodef_medusa_et_al.xml
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/XIOS2/iodef_medusa_et_al.xml	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/XIOS2/iodef_medusa_et_al.xml	(revision 8201)
@@ -0,0 +1,310 @@
+<!-- GO6.0 version of the XIOS namelist -->
+<!-- XIOS version 2 -->
+<?xml version="1.0"?>
+
+<simulation> 
+
+ <context id="nemo">
+    
+    <!-- $id$ -->
+    
+    <!-- 
+============================================================================================================
+=                                  definition of all existing variables                                    =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+    <field_definition src="./field_def_bgc.xml"/>
+    <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="1mo" 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="10d" output_freq="10d" output_level="10" enabled=".TRUE."/> <!-- 10d files -->
+      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE.">   <!-- 1m files -->   
+
+	<file id="file1" name_suffix="_grid_T" description="ocean T grid variables" >
+          <field field_ref="e3t"          name="e3t"        standard_name="cell_thickness" />
+          <field field_ref="toce"         name="votemper"        operation="average" freq_op="1mo" > @toce_e3t / @e3t </field>
+          <field field_ref="toce"         name="votemper2"       operation="average" freq_op="1mo" > @toce2_e3t / @e3t </field>
+          <field field_ref="soce"         name="vosaline"        operation="average" freq_op="1mo" > @soce_e3t / @e3t </field>
+          <field field_ref="soce"         name="vosaline2"       operation="average" freq_op="1mo" > @soce2_e3t / @e3t </field>
+          <field field_ref="ttrd_totad"   name="opottempadvect"  operation="average" freq_op="1mo" > @ttrd_totad_e3t * 1026.0 * 3991.86795711963 </field>
+          <field field_ref="ttrd_iso"     name="opottemppmdiff"  operation="average" freq_op="1mo" > @ttrd_iso_e3t * 1026.0 * 3991.86795711963 </field>
+          <field field_ref="ttrd_zdfp"    name="opottempdiff"    operation="average" freq_op="1mo" > @ttrd_zdfp_e3t * 1026.0 * 3991.86795711963 </field>
+          <field field_ref="ttrd_evd"     name="ttrd_evd"        operation="average" freq_op="1mo" > @ttrd_evd_e3t / @e3t </field>
+          <field field_ref="ttrd_qns"     name="ttrd_qns"        operation="average" freq_op="1mo" > @ttrd_qns_e3t / @e3t_surf </field>
+          <field field_ref="ttrd_qsr"     name="rsdoabsorb"      operation="average" freq_op="1mo" > @ttrd_qsr_e3t * 1026.0 * 3991.86795711963 </field>
+          <field field_ref="ttrd_bbl"     name="ttrd_bbl"        operation="average" freq_op="1mo" > @ttrd_bbl_e3t / @e3t </field>
+          <field field_ref="ttrd_tot"     name="opottemptend"    operation="average" freq_op="1mo" > @ttrd_tot_e3t * 1026.0 * 3991.86795711963 </field>
+          <field field_ref="strd_totad"   name="osaltadvect"     operation="average" freq_op="1mo" > @strd_totad_e3t * 1026.0 * 0.001 </field>
+          <field field_ref="strd_iso"     name="osaltpmdiff"     operation="average" freq_op="1mo" > @strd_iso_e3t * 1026.0 * 0.001  </field>
+          <field field_ref="strd_zdfp"    name="osaltdiff"       operation="average" freq_op="1mo" > @strd_zdfp_e3t * 1026.0 * 0.001  </field>
+          <field field_ref="strd_evd"     name="strd_evd"        operation="average" freq_op="1mo" > @strd_evd_e3t / @e3t </field>
+          <field field_ref="strd_tot"     name="osalttend"       operation="average" freq_op="1mo" > @strd_tot_e3t * 1026.0 * 0.001 </field>
+          <field field_ref="strd_bbl"     name="strd_bbl"        operation="average" freq_op="1mo" > @strd_bbl_e3t / @e3t </field>
+	  <field field_ref="ssh"          name="sossheig"   standard_name="sea_surface_height_above_geoid"                          />
+          <field field_ref="ssh2"         name="zossq"      standard_name="square_of_sea_surface_height_above_geoid"                />
+	  <field field_ref="empmr"        name="sowaflup"   standard_name="water_flux_out_of_sea_ice_and_sea_water"                 />
+	  <field field_ref="saltflx"      name="sosafldo"   standard_name="salt_flux_into_sea_water"                                />
+	  <field field_ref="qt"           name="sohefldo"   standard_name="surface_downward_heat_flux_in_sea_water"                 />
+	  <field field_ref="qsr"          name="soshfldo"   standard_name="downwelling_photosynthetic_radiative_flux_in_sea_water"               />
+          <field field_ref="mldkz5"       name="somixhgt"   standard_name="ocean_mixed_layer_thickness_defined_by_vertical_tracer_diffusivity"   />
+          <field field_ref="mldr10_1"     name="somxl010"   standard_name="ocean_mixed_layer_thickness_defined_by_sigma_theta"      />
+          <field field_ref="mldzint_1"    name="sokaraml"   standard_name="ocean_mixed_layer_thickness"                             />
+          <field field_ref="mldzint_2"    name="somlddbm"   standard_name="ocean_mixed_layer_thickness"                             />
+          <field field_ref="ice_cover"    name="soicecov"   standard_name="sea_ice_area_fraction"                                   />
+          <field field_ref="wspd"         name="sowindsp"   standard_name="wind_speed"                                              />          
+          <field field_ref="qhcisf"       name="sohflisf"   standard_name="ice_shelf_heat_flux"                                                        />
+          <field field_ref="qlatisf"      name="soqlatisf"  standard_name="ice_shelf_latent_heat_flux"                                                        />
+          <field field_ref="fwfisf"       name="sowflisf"   standard_name="ice_shelf_melting"                                                        />
+          <field field_ref="berg_total_melt"       name="berg_total_melt"          standard_name=""                                 />
+          <field field_ref="berg_total_heat_flux"  name="berg_total_heat_flux"     standard_name=""                                 />
+          <field field_ref="runoffs"       name="sorunoff"    standard_name="water_flux_into_sea_water_from_rivers"                 />
+          <field field_ref="hflx_rain_cea" name="hfrainds"    standard_name="temperature_flux_due_to_rainfall_expressed_as_heat_flux_into_sea_water"/>
+          <field field_ref="hflx_evap_cea" name="hfevapds"    standard_name="temperature_flux_due_to_evaporation_expressed_as_heat_flux_out_of_sea_water"/>
+          <field field_ref="evap_ao_cea"   name="evap_ao_cea" standard_name="water_evaporation_flux"                                />
+          <field field_ref="rain"          name="pr"          standard_name="rainfall_flux"                                         />
+          <field field_ref="snowpre"       name="snowpre"     standard_name="snowfall_flux"                                         />
+          <field field_ref="snow_ao_cea"   name="snow_ao_cea" standard_name="snowfall_flux_over_ocean"                              />
+          <field field_ref="snow_ai_cea"   name="snow_ai_cea" standard_name="snowfall_flux_over_sea_ice"                            />
+	</file>
+	
+	<file id="file2" name_suffix="_grid_U" description="ocean U grid variables" >
+          <field field_ref="e3u"          name="e3u"        standard_name="cell_thickness" />
+          <field field_ref="uoce"         name="vozocrtx"     operation="average" freq_op="1mo" > @uoce_e3u / @e3u </field>
+          <field field_ref="uoce"         name="vozocrtx2"    operation="average" freq_op="1mo" > @uoce2_e3u / @e3u </field>
+          <field field_ref="ut"           name="ut"           operation="average" freq_op="1mo" > @ut_e3u / @e3u </field>
+          <field field_ref="us"           name="us"           operation="average" freq_op="1mo" > @us_e3u / @e3u </field>
+	  <field field_ref="utau"         name="sozotaux"   standard_name="surface_downward_x_stress" />
+	</file>
+	
+	<file id="file3" name_suffix="_grid_V" description="ocean V grid variables" >
+          <field field_ref="e3v"          name="e3v"        standard_name="cell_thickness" />
+          <field field_ref="voce"         name="vomecrty"     operation="average" freq_op="1mo" > @voce_e3v / @e3v </field>
+          <field field_ref="voce"         name="vomecrty2"    operation="average" freq_op="1mo" > @voce2_e3v / @e3v </field>
+          <field field_ref="vt"           name="vt"           operation="average" freq_op="1mo" > @vt_e3v / @e3v </field>
+          <field field_ref="vs"           name="vs"           operation="average" freq_op="1mo" > @vs_e3v / @e3v </field>
+	  <field field_ref="vtau"         name="sometauy"   standard_name="surface_downward_y_stress" />
+	</file>
+	
+	<file id="file4" name_suffix="_grid_W" description="ocean W grid variables" >
+	  <field field_ref="woce"         name="vovecrtz"   standard_name="upward_sea_water_velocity"                         />
+          <field field_ref="wt"           name="wt"         standard_name=""                                                  />
+          <field field_ref="ws"           name="ws"         standard_name=""                                                  />
+	  <field field_ref="avt"          name="votkeavt"   standard_name="ocean_vertical_heat_diffusivity"                   />
+          <field field_ref="avm"          name="votkeavm"   standard_name="ocean_vertical_momentum_diffusivity"               />
+          <field field_ref="aht2d"        name="soleahtw"   standard_name="vertical_component_of_ocean_xy_tracer_diffusivity" />
+	</file>
+        
+        <file id="file5" name_suffix="_diaptr" description="processed diagnostics" >
+	  <field field_ref="zomsfglo"     name="zomsfglo"   standard_name="meridional_streamfunction_global"           grid_ref="gznl_W_3D"       />
+          <field field_ref="zotemglo"     name="zotemglo"   standard_name="zonal_mean_temperature_global"              grid_ref="gznl_T_3D"       />
+          <field field_ref="zosrfglo"     name="zosrfglo"   standard_name="zonal_mean_surface_global"                  grid_ref="gznl_T_3D"       />
+	  <field field_ref="zosalglo"     name="zosalglo"   standard_name="zonal_mean_salinity_global"                 grid_ref="gznl_T_3D"       />          
+          <field field_ref="zomsfatl"     name="zomsfatl"   standard_name="meridional_streamfunction_atlantic"         grid_ref="gznl_W_3D"       />
+          <field field_ref="zotematl"     name="zotematl"   standard_name="zonal_mean_temperature_atlantic"            grid_ref="gznl_T_3D"       />
+          <field field_ref="zosrfatl"     name="zosrfatl"   standard_name="zonal_mean_surface_atlantic"                grid_ref="gznl_T_3D"       />
+	  <field field_ref="zosalatl"     name="zosalatl"   standard_name="zonal_mean_salinity_atlantic"               grid_ref="gznl_T_3D"       />          
+          <field field_ref="zomsfpac"     name="zomsfpac"   standard_name="meridional_streamfunction_pacific"          grid_ref="gznl_W_3D"       />
+          <field field_ref="zotempac"     name="zotempac"   standard_name="zonal_mean_temperature_pacific"             grid_ref="gznl_T_3D"       />
+          <field field_ref="zosrfpac"     name="zosrfpac"   standard_name="zonal_mean_surface_pacific"                 grid_ref="gznl_T_3D"       />
+	  <field field_ref="zosalpac"     name="zosalpac"   standard_name="zonal_mean_salinity_pacific"                grid_ref="gznl_T_3D"       />
+          <field field_ref="zomsfind"     name="zomsfind"   standard_name="meridional_streamfunction_indian"           grid_ref="gznl_W_3D"       />
+          <field field_ref="zotemind"     name="zotemind"   standard_name="zonal_mean_temperature_indian"              grid_ref="gznl_T_3D"       />
+          <field field_ref="zosrfind"     name="zosrfind"   standard_name="zonal_mean_surface_indian"                  grid_ref="gznl_T_3D"       />
+	  <field field_ref="zosalind"     name="zosalind"   standard_name="zonal_mean_salinity_indian"                 grid_ref="gznl_T_3D"       />          
+          <field field_ref="zomsfipc"     name="zomsfipc"   standard_name="meridional_streamfunction_indian_pacific"   grid_ref="gznl_W_3D"       />
+          <field field_ref="zotemipc"     name="zotemipc"   standard_name="zonal_mean_temperature_indian_pacific"      grid_ref="gznl_T_3D"       />
+          <field field_ref="zosrfipc"     name="zosrfipc"   standard_name="zonal_mean_surface_indian_pacific"          grid_ref="gznl_T_3D"       />
+	  <field field_ref="zosalipc"     name="zosalipc"   standard_name="zonal_mean_salinity_indian_pacific"         grid_ref="gznl_T_3D"       />          
+          <field field_ref="sophtadv"     name="sophtadv"   standard_name="advective_heat_transport"                   grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstadv"     name="sopstadv"   standard_name="advective_salt_transport"                   grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtldf"     name="sophtldf"   standard_name="diffusive_heat_transport"                   grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstldf"     name="sopstldf"   standard_name="diffusive_salt_transport"                   grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtadv_atl" name="sophtadv_atl"   standard_name="advective_heat_transport_atlantic"      grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstadv_atl" name="sopstadv_atl"   standard_name="advective_salt_transport_atlantic"      grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtldf_atl" name="sophtldf_atl"   standard_name="diffusive_heat_transport_atlantic"      grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstldf_atl" name="sopstldf_atl"   standard_name="diffusive_salt_transport_atlantic"      grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtadv_pac" name="sophtadv_pac"   standard_name="advective_heat_transport_pacific"       grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstadv_pac" name="sopstadv_pac"   standard_name="advective_salt_transport_pacific"       grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtldf_pac" name="sophtldf_pac"   standard_name="diffusive_heat_transport_pacific"       grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstldf_pac" name="sopstldf_pac"   standard_name="diffusive_salt_transport_pacific"       grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtadv_ind" name="sophtadv_ind"   standard_name="advective_heat_transport_indian"        grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstadv_ind" name="sopstadv_ind"   standard_name="advective_salt_transport_indian"        grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtldf_ind" name="sophtldf_ind"   standard_name="diffusive_heat_transport_indian"        grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstldf_ind" name="sopstldf_ind"   standard_name="diffusive_salt_transport_indian"        grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtadv_ipc" name="sophtadv_ipc"   standard_name="advective_heat_transport_indopacific"   grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstadv_ipc" name="sopstadv_ipc"   standard_name="advective_salt_transport_indopacific"   grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtldf_ipc" name="sophtldf_ipc"   standard_name="diffusive_heat_transport_indopacific"   grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstldf_ipc" name="sopstldf_ipc"   standard_name="diffusive_salt_transport_indopacific"   grid_ref="gznl_T_2D"       />
+	</file>
+
+        <file id="file6" name_suffix="_ptrc_T" description="Medusa sms variables" >
+          <field_group group_ref="groupMEDUSA" />
+          <field_group group_ref="groupIDTRA" />
+          <field_group group_ref="groupCFC" />
+          <field_group group_ref="groupAGE" />
+        </file>
+
+        <file id="file7" name_suffix="_diad_T" description="Medusa diagnostic variables" >
+          <field_group group_ref="groupMEDUSA_dia" />
+          <field_group group_ref="groupMEDUSA_3dd" />
+          <field_group group_ref="groupMEDUSA_dms" />
+          <field_group group_ref="groupIDTRA_dia" />
+          <field_group group_ref="groupCFC_dia" />
+          <field_group group_ref="groupMEDUSA_cmip6" />
+        </file>
+
+      </file_group>
+
+      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files -->
+      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files -->
+      <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files -->
+      <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files -->
+
+      <file_group id="1y"  output_freq="1y" output_level="10" enabled=".TRUE."/> <!-- real yearly files -->
+      <file_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" standard_name="depth" long_name="Vertical T levels" unit="m" positive="down" />
+      <axis id="depthu" standard_name="depth" long_name="Vertical U levels" unit="m" positive="down" />
+      <axis id="depthv" standard_name="depth" long_name="Vertical V levels" unit="m" positive="down" />
+      <axis id="depthw" standard_name="depth" 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 id="ncatice" long_name="Ice category"       unit="1"               />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"            />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"            />
+      <axis id="deptht_surface" axis_ref="deptht" >
+         <zoom_axis begin=" 1 " n=" 1 " />
+      </axis>
+
+   </axis_definition>
+    
+   <domain_definition src="./domain_def.xml"/>
+   
+    <grid_definition>
+        <!--  -->
+       <grid id="grid_T_2D" >
+         <domain id="grid_T" />
+       </grid>
+        <!--  -->
+       <grid id="grid_T_3D_ncatice" >
+         <domain id="grid_T" />
+         <axis id="ncatice" />
+       </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="grid_1point" >
+         <domain id="1point"/>
+       </grid>
+        <!--  -->
+       <grid id="grid_T_nfloat" >
+         <domain id="grid_T" />
+         <axis id="nfloat" />
+       </grid>
+        <!--  -->
+       <grid id="grid_EqT" >
+         <domain id="EqT" />
+       </grid>
+        <!--  -->
+       <grid id="gznl_T_2D">
+         <domain id="ptr" />
+       </grid>
+        <!--  -->
+       <grid id="gznl_T_3D">
+         <domain id="ptr" />
+         <axis id="deptht" />
+       </grid>
+        <!--  -->
+       <grid id="gznl_W_2D">
+         <domain id="ptr" />
+       </grid>
+        <!--  -->
+       <grid id="gznl_W_3D">
+         <domain id="ptr" />
+         <axis id="depthw" />
+       </grid>
+        <!--  -->
+       <grid id="grid_T_surface_extract">
+         <domain domain_ref="grid_T" />
+         <axis   axis_ref="deptht_surface" />
+       </grid>
+
+    </grid_definition>
+  </context>
+  
+
+  <context id="xios">
+
+      <variable_definition>
+	
+	  <variable id="info_level"            type="int">0</variable>
+	  <variable id="using_server"          type="bool">false</variable>
+	  <variable id="using_oasis"           type="bool">true</variable>
+	  <variable id="oasis_codes_id"        type="string" >toyoce</variable>
+	
+      </variable_definition>
+               
+  </context>
+  
+</simulation>
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/cfc1112sf6.atm
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/cfc1112sf6.atm	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/cfc1112sf6.atm	(revision 8201)
@@ -0,0 +1,92 @@
+% Atmospheric lifetimes are   44 for CFC-11
+%                       and  125 for CFC-12
+%			and 1278 for SF6    (Kovacs et al., 2017)
+% rel=  0
+%        <-Northern Data->       <-Southern Data->
+% Year  CFC-11  CFC-12  SF6     CFC-11  CFC-12  SF6
+%       (ppt)   (ppt)   (ppt)   (ppt)   (ppt)   (ppt)
+1931.5	 0.00	 0.00	 0.00	 0.00	 0.00	 0.00
+1932.5	 0.00	 0.00	 0.00	 0.00	 0.00	 0.00
+1933.5	 0.00	 0.00	 0.00	 0.00	 0.00	 0.00
+1934.5	 0.00	 0.00	 0.00	 0.00	 0.00	 0.00
+1935.5	 0.00	 0.00	 0.00	 0.00	 0.00	 0.00
+1936.5	 0.00	 0.10	 0.00	 0.00	 0.00	 0.00
+1937.5	 0.00	 0.10	 0.00	 0.00	 0.10	 0.00
+1938.5	 0.00	 0.20	 0.00	 0.00	 0.10	 0.00
+1939.5	 0.00	 0.30	 0.00	 0.00	 0.20	 0.00
+1940.5	 0.00	 0.40	 0.00	 0.00	 0.30	 0.00
+1941.5	 0.00	 0.50	 0.00	 0.00	 0.40	 0.00
+1942.5	 0.00	 0.70	 0.00	 0.00	 0.50	 0.00
+1943.5	 0.00	 0.90	 0.00	 0.00	 0.70	 0.00
+1944.5	 0.00	 1.20	 0.00	 0.00	 0.90	 0.00
+1945.5	 0.10	 1.70	 0.00	 0.00	 1.20	 0.00
+1946.5	 0.10	 2.30	 0.00	 0.10	 1.70	 0.00
+1947.5	 0.10	 3.40	 0.00	 0.10	 2.40	 0.00
+1948.5	 0.20	 4.80	 0.00	 0.10	 3.40	 0.00
+1949.5	 0.40	 6.10	 0.00	 0.20	 4.70	 0.00
+1950.5	 0.70	 7.60	 0.00	 0.40	 6.00	 0.00
+1951.5	 1.01	 9.20	 0.00	 0.70	 7.40	 0.00
+1952.5	 1.51	11.00	 0.00	 1.01	 9.00	 0.00
+1953.5	 2.21	12.80	 0.04	 1.51	10.70	 0.04
+1954.5	 3.02	15.00	 0.04	 2.21	12.60	 0.04
+1955.5	 4.12	17.40	 0.04	 3.02	14.70	 0.04
+1956.5	 5.33	20.20	 0.04	 4.02	17.10	 0.04
+1957.5	 6.83	23.40	 0.05	 5.23	19.90	 0.04
+1958.5	 8.14	26.80	 0.05	 6.53	23.00	 0.04
+1959.5	 9.45	30.50	 0.05	 7.84	26.30	 0.05
+1960.5	11.06	35.00	 0.05	 9.15	30.10	 0.05
+1961.5	13.27	40.00	 0.06	10.85	34.40	 0.06
+1962.5	16.18	45.80	 0.07	13.07	39.40	 0.06
+1963.5	19.60	52.50	 0.08	15.78	45.10	 0.07
+1964.5	23.72	60.40	 0.09	19.20	51.80	 0.08
+1965.5	28.44	69.30	 0.11	23.12	59.50	 0.10
+1966.5	33.67	79.20	 0.13	27.64	68.20	 0.12
+1967.5	39.40	90.30	 0.15	32.66	77.90	 0.14
+1968.5	46.03	102.80	 0.18	38.29	88.80	 0.17
+1969.5	53.77	116.80	 0.21	44.82	101.10	 0.19
+1970.5	62.41	132.00	 0.23	52.26	114.70	 0.22
+1971.5	72.06	148.40	 0.26	60.70	129.60	 0.24
+1972.5	82.71	166.10	 0.30	69.95	145.70	 0.28
+1973.5	94.87	185.80	 0.34	80.40	163.30	 0.31
+1974.5	108.34	207.10	 0.38	92.16	182.50	 0.35
+1975.5	121.41	228.20	 0.44	104.72	202.90	 0.40
+1976.5	133.97	248.10	 0.50	117.09	223.20	 0.46
+1977.5	145.93	266.90	 0.58	129.35	242.70	 0.53
+1978.5	156.58	284.30	 0.66	140.80	261.20	 0.61
+1979.5	168.34	306.10	 0.76	148.74	273.50	 0.70
+1980.5	176.68	323.20	 0.88	159.30	292.30	 0.81
+1981.5	184.32	339.60	 1.00	167.84	308.80	 0.93
+1982.5	191.46	353.40	 1.13	176.08	325.50	 1.04
+1983.5	199.30	369.00	 1.27	184.52	342.60	 1.17
+1984.5	208.04	385.70	 1.40	192.46	359.40	 1.29
+1985.5	217.99	403.40	 1.55	202.01	378.20	 1.43
+1986.5	229.35	424.30	 1.71	211.36	396.50	 1.58
+1987.5	241.61	444.00	 1.88	222.21	416.30	 1.73
+1988.5	252.86	465.40	 2.05	233.27	435.80	 1.89
+1989.5	259.30	483.60	 2.22	242.11	454.40	 2.05
+1990.5	265.83	497.70	 2.41	251.06	472.70	 2.22
+1991.5	268.24	506.00	 2.62	256.68	487.30	 2.42
+1992.5	268.14	516.30	 2.85	260.80	498.30	 2.63
+1993.5	269.55	523.20	 3.09	262.51	507.00	 2.84
+1994.5	269.65	528.50	 3.33	263.72	514.80	 3.07
+1995.5	268.34	533.40	 3.58	263.22	521.00	 3.30
+1996.5	266.93	537.30	 3.86	262.91	526.50	 3.55
+1997.5	265.73	540.10	 4.07	262.01	530.80	 3.81
+1998.5	264.52	542.90	 4.25	261.01	534.30	 4.01
+1999.5	263.12	544.40	 4.48	259.90	537.20	 4.25
+2000.5	261.71	545.90	 4.68	258.29	539.00	 4.46
+2001.5	260.00	546.50	 4.90	256.98	540.60	 4.65
+2002.5	258.19	546.70	 5.14	255.08	541.30	 4.88
+2003.5	256.18	546.70	 5.37	253.27	541.60	 5.07
+2004.5	253.97	545.70	 5.58	251.36	541.50	 5.30
+2005.5	251.96	544.90	 5.80	249.15	540.70	 5.51
+2006.5	249.55	543.10	 6.04	247.34	539.80	 5.75
+2007.5	247.54	541.10	 6.33	245.03	538.10	 6.03
+2008.5	245.63	538.60	 6.62	243.12	536.20	 6.29
+2009.5	243.61	536.12	 6.89	241.05	533.47	 6.58
+2010.5	241.31	533.26	 7.21	239.15	531.03	 6.87
+2011.5	239.40	530.60	 7.46	236.84	528.53	 7.17
+2012.5	236.89	527.20	 7.73	234.77	526.00	 7.43
+2013.5	235.57	525.22	 8.09	232.88	523.25	 7.73
+2014.5	234.97	522.97	 8.40	231.49	521.00	 8.11
+2015.5	234.36	520.71	 8.72	230.09	518.74	 8.50
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/field_def_bgc.xml
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/field_def_bgc.xml	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/field_def_bgc.xml	(revision 8201)
@@ -0,0 +1,865 @@
+<!--
+< GO6.0 version of the XIOS namelist >
+< XIOS2 version namelist >
+
+<?xml version="1.0"?>
+       -->
+ 
+    <!-- $id$ -->
+    
+    <!-- 
+============================================================================================================
+=                                  definition of all existing variables                                    =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+   <field_definition level="1" prec="8" operation="average" enabled=".TRUE." default_value="1.e20" > <!-- time step automaticaly defined -->
+
+    <!-- 
+============================================================================================================
+                                     Biogeochemistry model variables
+============================================================================================================
+    -->
+
+      <!-- ptrc on T grid -->
+
+     <field_group id="ptrc_T" grid_ref="grid_T_3D">
+       <field id="DIC"          long_name="Dissolved inorganic Concentration"        unit="mmol/m3" />
+       <field id="DIC_E3T"      long_name="DIC * E3T"                                unit="mmol/m2" > DIC * e3t </field >
+       <field id="Alkalini"     long_name="Total Alkalinity Concentration"           unit="mmol/m3" />
+       <field id="Alkalini_E3T" long_name="Alkalini * E3T"                           unit="mmol/m2"  > Alkalini * e3t </field >
+       <field id="O2"           long_name="Oxygen Concentration"                     unit="mmol/m3" />
+       <field id="O2_E3T"       long_name="O2 * E3T"                                 unit="mmol/m2"  > O2 * e3t </field >
+       <field id="CaCO3"        long_name="Calcite Concentration"                    unit="mmol/m3" />
+       <field id="CaCO3_E3T"    long_name="CaCO3 * E3T"                              unit="mmol/m2"  > CaCO3 * e3t </field >
+       <field id="PO4"          long_name="Phosphate Concentration"                  unit="mmol/m3" />
+       <field id="PO4_E3T"      long_name="PO4 * E3T"                                unit="mmol/m2"  > PO4 * e3t </field >
+       <field id="POC"          long_name="Small organic carbon Concentration"       unit="mmol/m3" />
+       <field id="POC_E3T"      long_name="POC * E3T"                                unit="mmol/m2"  > POC * e3t </field >
+       <field id="Si"           long_name="Silicate Concentration"                   unit="mmol/m3" />
+       <field id="Si_E3T"       long_name="Si * E3T"                                 unit="mmol/m2"  > Si * e3t </field >
+       <field id="PHY"          long_name="(Nano)Phytoplankton Concentration"        unit="mmol/m3" />
+       <field id="PHY_E3T"      long_name="PHY * E3T"                                unit="mmol/m2"  > PHY * e3t </field >
+       <field id="ZOO"          long_name="(Micro)Zooplankton Concentration"         unit="mmol/m3" />
+       <field id="ZOO_E3T"      long_name="ZOO2 * E3T"                               unit="mmol/m2"  > ZOO * e3t </field >
+       <field id="DOC"          long_name="Dissolved organic Concentration"          unit="mmol/m3" />
+       <field id="DOC_E3T"      long_name="DOC * E3T"                                unit="mmol/m2"  > DOC * e3t </field >
+       <field id="PHY2"         long_name="Diatoms Concentration"                    unit="mmol/m3" />
+       <field id="PHY2_E3T"     long_name="PHY2 * E3T"                               unit="mmol/m2"  > PHY2 * e3t </field >
+       <field id="ZOO2"         long_name="Mesozooplankton Concentration"            unit="mmol/m3" />
+       <field id="ZOO2_E3T"     long_name="ZOO2 * E3T"                               unit="mmol/m2"  > ZOO2 * e3t </field >
+       <field id="DSi"          long_name="Diatoms Silicate Concentration"           unit="mmol/m3" />
+       <field id="DSi_E3T"      long_name="Dsi * E3T"                                unit="mmol/m2"  > DSi * e3t </field >
+       <field id="Fer"          long_name="Dissolved Iron Concentration"             unit="mmol/m3" />
+       <field id="Fer_E3T"      long_name="Fer * E3T"                                unit="mmol/m2"  > Fer * e3t </field >
+       <field id="BFe"          long_name="Big iron particles Concentration"         unit="mmol/m3" />
+       <field id="BFe_E3T"      long_name="BFe * E3T"                                unit="mmol/m2"  > BFe * e3t </field >
+       <field id="GOC"          long_name="Big organic carbon Concentration"         unit="mmol/m3" />
+       <field id="GOC_E3T"      long_name="GOC * E3T"                                unit="mmol/m2"  > GOC * e3t </field >
+       <field id="SFe"          long_name="Small iron particles Concentration"       unit="mmol/m3" />
+       <field id="SFe_E3T"      long_name="SFe * E3T"                                unit="mmol/m2"  > SFe * e3t </field >
+       <field id="DFe"          long_name="Diatoms iron  Concentration"              unit="mmol/m3" />
+       <field id="DFe_E3T"      long_name="DFe * E3T"                                unit="mmol/m2"  > DFe * e3t </field >
+       <field id="GSi"          long_name="Sinking biogenic Silicate Concentration"  unit="mmol/m3" />
+       <field id="GSi_E3T"      long_name="GSi * E3T"                                unit="mmol/m2"  > GSi * e3t </field >
+       <field id="NFe"          long_name="Nano iron Concentration"                  unit="mmol/m3" />
+       <field id="NFe_E3T"      long_name="NFe * E3T"                                unit="mmol/m2"  > NFe * e3t </field >
+       <field id="NCHL"         long_name="Nano chlorophyl Concentration"            unit="mg/m3"   />
+       <field id="NCHL_E3T"     long_name="NCHL * E3T"                               unit="mmol/m2"  > NCHL * e3t </field >
+       <field id="DCHL"         long_name="Diatoms chlorophyl Concentration"         unit="mg/m3"   />
+       <field id="DCHL_E3T"     long_name="DCHL * E3T"                               unit="mmol/m2"  > DCHL * e3t </field >
+       <field id="NO3"          long_name="Nitrate Concentration"                    unit="mmol/m3" />
+       <field id="NO3_E3T"      long_name="NO3 * E3T"                                unit="mmol/m2"  > NO3 * e3t </field >
+       <field id="NH4"          long_name="Ammonium Concentration"                   unit="mmol/m3" />
+       <field id="NH4_E3T"      long_name="NH4 * E3T"                                unit="mmol/m2"  > NH4 * e3t </field >
+
+      <!-- MEDUSA : variables available with key_medusa -->
+       <field id="CHN"      long_name="Chl-a concentration in non-diatom phytoplankton"   unit="mg Chl/m3" />
+       <field id="CHN_E3T"  long_name="CHN * E3T"                                         unit="mg Chl/m2"  > CHN * e3t </field > 
+       <field id="CHD"      long_name="Chl-a concentration in     diatom phytoplankton"   unit="mg Chl/m3" />
+       <field id="CHD_E3T"  long_name="CHD * E3T"                                         unit="mg Chl/m2"  > CHD * e3t </field >
+       <field id="PHN"      long_name="non-diatom phytoplankton"                          unit="mmol-N/m3" />
+       <field id="PHN_E3T"  long_name="PHN * E3T"                                         unit="mmol-N/m2"  > PHN * e3t </field >
+       <field id="PHD"      long_name="diatom     phytoplankton"                          unit="mmol-N/m3" />
+       <field id="PHD_E3T"  long_name="PHD * E3T"                                         unit="mmol-N/m2"  > PHD * e3t </field >
+       <field id="ZMI"      long_name="micro zooplankton"                                 unit="mmol-N/m3" />
+       <field id="ZMI_E3T"  long_name="ZMI * E3T"                                         unit="mmol-N/m2"  > ZMI * e3t </field >
+       <field id="ZME"      long_name="meso  zooplankton"                                 unit="mmol-N/m3" />
+       <field id="ZME_E3T"  long_name="ZME * E3T"                                         unit="mmol-N/m2"  > ZME * e3t </field >
+       <field id="DIN"      long_name="dissolved inorganic nitrogen"                      unit="mmol-N/m3" />
+       <field id="DIN_E3T"  long_name="DIN * E3T"                                         unit="mmol-N/m2"  > DIN * e3t </field >
+       <field id="SIL"      long_name="dissolved silicic acid"                            unit="mmolSi/m3" />
+       <field id="SIL_E3T"  long_name="SIL * E3T"                                         unit="mmolSi/m2"  > SIL * e3t </field >
+       <field id="FER"      long_name="dissolved iron"                                    unit="mmolFe/m3" />
+       <field id="FER_E3T"  long_name="FER * E3T"                                         unit="mmolFe/m2"  > FER * e3t </field >
+       <field id="DET"      long_name="detrital nitrogen"                                 unit="mmol-N/m3" />
+       <field id="DET_E3T"  long_name="DET * E3T"                                         unit="mmol-N/m2"  > DET * e3t </field >
+       <field id="PDS"      long_name="biogenic silicon in diatom phytoplankton"          unit="mmolSi/m3" />
+       <field id="PDS_E3T"  long_name="PDS * E3T"                                         unit="mmolSi/m2"  > PDS * e3t </field >
+       <field id="DTC"      long_name="detrital carbon"                                   unit="mmol-C/m3" />
+       <field id="DTC_E3T"  long_name="DTC * E3T"                                         unit="mmol-C/m2"  > DTC * e3t </field >
+       <field id="DiC"      long_name="dissolved inorganic carbon"                        unit="mmol-C/m3" />
+       <field id="DiC_E3T"  long_name="DiC * E3T"                                         unit="mmol-C/m2"  > DiC * e3t </field >
+       <field id="ALK"      long_name="alkalinity"                                        unit="meq/m3"    />
+       <field id="ALK_E3T"  long_name="ALK * E3T"                                         unit="meq/m2"     > ALK * e3t </field >
+       <field id="OXY"      long_name="dissolved oxygen"                                  unit="mmolO2/m3" />
+       <field id="OXY_E3T"  long_name="OXY * E3T"                                         unit="mmolO2/m2"  > OXY * e3t </field >
+
+      <!-- Ideal traceurs : variables available with key_idtra -->
+       <field id="IDTRA"    long_name="Ideal traceur concentration "                      unit="mmol/m3"    />
+
+       <!-- PISCES with Kriest parametisation : variables available with key_kriest -->
+       <field id="Num"         long_name="Number of organic particles"              unit="1" />
+       <field id="Num_E3T"     long_name="Num * E3T"                                unit="m"  > Num * e3t </field >
+
+       <!-- PISCES light : variables available with key_pisces_reduced -->
+       <field id="DET"         long_name="Detritus"                                 unit="mmol-N/m3" />
+       <field id="DET_E3T"     long_name="DET * E3T"                                unit="mmol-N/m2"  > DET * e3t </field >
+       <field id="DOM"         long_name="Dissolved Organic Matter"                 unit="mmol-N/m3" />
+       <field id="DOM_E3T"     long_name="DOM * E3T"                                unit="mmol-N/m2"  > DOM * e3t </field >
+
+       <!-- CFC11 : variables available with key_cfc -->
+       <field id="CFC11"       long_name="CFC-11 Concentration"                     unit="umol/m3" />
+       <field id="CFC11_E3T"   long_name="CFC11 * E3T"                              unit="umol/m2"  > CFC11 * e3t </field >
+       <!-- CFC12 : variables available with key_cfc -->
+       <field id="CFC12"       long_name="CFC-12 Concentration"                     unit="umol/m3" />
+       <field id="CFC12_E3T"   long_name="CFC12 * E3T"                              unit="umol/m2"  > CFC12 * e3t </field >
+       <!-- SF6 : variables available with key_cfc -->
+       <field id="SF6"         long_name="SF6 Concentration"                        unit="umol/m3" />
+       <field id="SF6_E3T"     long_name="SF6 * E3T"                                unit="umol/m2"  > SF6 * e3t </field >
+       <!-- Bomb C14 : variables available with key_c14b -->
+       <field id="C14B"        long_name="Bomb C14 Concentration"                   unit="1"         />
+       <field id="C14B_E3T"    long_name="C14B * E3T"                               unit="m"  > C14B * e3t </field >
+       <!-- AGE : variables available with key_age -->
+       <field id="Age"        long_name="Sea Water Age Since Surface contact" standard_name="sea_water_age_since_surface_contact"  unit="yr"         />
+       <field id="Age_e3t"    long_name="Age * e3t"                                 unit="yr * m"  > Age * e3t </field >
+     </field_group>
+
+     <!-- PISCES additional diagnostics on T grid  -->
+
+     <field_group id="diad_T" grid_ref="grid_T_2D">
+       <field id="PH"          long_name="PH"                                      unit="1"          grid_ref="grid_T_3D" />
+       <field id="CO3"         long_name="Bicarbonates"                            unit="mol/m3"     grid_ref="grid_T_3D" />
+       <field id="CO3sat"      long_name="CO3 saturation"                          unit="mol/m3"     grid_ref="grid_T_3D" />
+       <field id="PAR"         long_name="Photosynthetically Available Radiation"  unit="W/m2"       grid_ref="grid_T_3D" />
+       <field id="PARDM"       long_name="Daily mean PAR"                          unit="W/m2"       grid_ref="grid_T_3D" />
+       <field id="PPPHY"       long_name="Primary production of nanophyto"         unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="PPPHY2"      long_name="Primary production of diatoms"           unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="PPNEWN"      long_name="New Primary production of nanophyto"     unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="PPNEWD"      long_name="New Primary production of diatoms"       unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="PBSi"        long_name="Primary production of Si diatoms"        unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="PFeN"        long_name="Primary production of nano iron"         unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="PFeD"        long_name="Primary production of diatoms iron"      unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="xfracal"     long_name="Calcifying fraction"                     unit="1"          grid_ref="grid_T_3D" />
+       <field id="PCAL"        long_name="Calcite production"                      unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="DCAL"        long_name="Calcite dissolution"                     unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="GRAZ1"       long_name="Grazing by microzooplankton"             unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="GRAZ2"       long_name="Grazing by mesozooplankton"              unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="REMIN"       long_name="Oxic remineralization of OM"             unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="DENIT"       long_name="Anoxic remineralization of OM"           unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="Nfix"        long_name="Nitrogen fixation"                       unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="Mumax"       long_name="Maximum growth rate"                     unit="s-1"        grid_ref="grid_T_3D" />
+       <field id="MuN"         long_name="Realized growth rate for nanophyto"      unit="s-1"        grid_ref="grid_T_3D" />
+       <field id="MuD"         long_name="Realized growth rate for diatomes"       unit="s-1"        grid_ref="grid_T_3D" />
+       <field id="LNnut"       long_name="Nutrient limitation term in Nanophyto"   unit=""           grid_ref="grid_T_3D" />
+       <field id="LDnut"       long_name="Nutrient limitation term in Diatoms"     unit=""           grid_ref="grid_T_3D" />
+       <field id="LNFe"        long_name="Iron limitation term in Nanophyto"       unit=""           grid_ref="grid_T_3D" />
+       <field id="LDFe"        long_name="Iron limitation term in Diatoms"         unit=""           grid_ref="grid_T_3D" />
+       <field id="LNlight"     long_name="Light limitation term in Nanophyto"      unit=""           grid_ref="grid_T_3D" />
+       <field id="LDlight"     long_name="Light limitation term in Diatoms"        unit=""           grid_ref="grid_T_3D" />
+       <field id="Fe2"         long_name="Iron II concentration"                   unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="Fe3"         long_name="Iron III concentration"                  unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="FeL1"        long_name="Complexed Iron concentration with L1"    unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="FeL2"        long_name="Complexed Iron concentration with L2"    unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="FeP"         long_name="Precipitated Iron III"                   unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="TL1"         long_name="Total L1 concentration"                  unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="TL2"         long_name="Total L2 concentration"                  unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="pdust"       long_name="dust concentration"                      unit="g/m3"                            />
+       <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="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" />
+       <field id="EPC100"      long_name="Export of carbon particles at 100 m"     unit="mol/m2/s"                        />
+       <field id="EPFE100"     long_name="Export of biogenic iron at 100 m"        unit="mol/m2/s"                        />
+       <field id="EPSI100"     long_name="Export of Silicate at 100 m"             unit="mol/m2/s"                        />
+       <field id="EPCAL100"    long_name="Export of Calcite at 100 m"              unit="mol/m2/s"                        />
+       <field id="EXPC"        long_name="Export of carbon"                        unit="mol/m2/s"   grid_ref="grid_T_3D" />
+       <field id="EXPFE"       long_name="Export of biogenic iron"                 unit="mol/m2/s"   grid_ref="grid_T_3D" />
+       <field id="EXPSI"       long_name="Export of Silicate"                      unit="mol/m2/s"   grid_ref="grid_T_3D" />
+       <field id="EXPCAL"      long_name="Export of Calcite"                       unit="mol/m2/s"   grid_ref="grid_T_3D" />
+       <field id="Cflx"        long_name="DIC flux"                                unit="mol/m2/s"                        />
+       <field id="Oflx"        long_name="Oxygen flux"                             unit="mol/m2/s"                        />
+       <field id="Kg"          long_name="Gas transfer"                            unit="mol/m2/s/uatm"                   />
+       <field id="Dpco2"       long_name="Delta CO2"                               unit="uatm"                            />
+       <field id="Dpo2"        long_name="Delta O2"                                unit="uatm"                            />
+       <field id="Heup"        long_name="Euphotic layer depth"                    unit="m"                               />
+       <field id="Irondep"     long_name="Iron deposition from dust"               unit="mol/m2/s"                        />
+       <field id="Ironsed"     long_name="Iron deposition from sediment"           unit="mol/m2/s"   grid_ref="grid_T_3D" />
+
+
+       <!-- PISCES with Kriest parametisation : variables available with key_kriest -->
+       <field id="EPN100"      long_name="Particulate number flux at 100 m"        unit="mol/m2/s"                        />
+       <field id="EXPN"        long_name="Particulate number flux"                 unit="mol/m2/s"   grid_ref="grid_T_3D" />
+       <field id="XNUM"        long_name="Number of particles in aggregats"        unit="1"          grid_ref="grid_T_3D" />
+       <field id="WSC"         long_name="sinking speed of mass flux"              unit="m2/s"       grid_ref="grid_T_3D" />
+       <field id="WSN"         long_name="sinking speed of number flux"            unit="m2/s"       grid_ref="grid_T_3D" />
+
+       <!-- dbio_T on T grid : variables available with key_diaar5 -->
+       <field id="TPP"         long_name="Total Primary production of phyto"                   unit="mol/m3/s"  grid_ref="grid_T_3D" />
+       <field id="TPNEW"       long_name="New Primary production of phyto"                     unit="mol/m3/s"  grid_ref="grid_T_3D" />
+       <field id="TPBFE"       long_name="Total biogenic iron production"                      unit="mol/m3/s"  grid_ref="grid_T_3D" />
+       <field id="INTDIC"      long_name="DIC content"                                         unit="kg/m2"                          />
+       <field id="O2MIN"       long_name="Oxygen minimum concentration"                        unit="mol/m3"                          />
+       <field id="ZO2MIN"      long_name="Depth of oxygen minimum concentration"               unit="m"                              />
+       <field id="INTNFIX"     long_name="Nitrogen fixation rate : vert. integrated"           unit="mol/m2/s"                       />
+       <field id="INTPPPHY"    long_name="Vertically integrated primary production by nanophy" unit="mol/m2/s"                       />
+       <field id="INTPPPHY2"   long_name="Vertically integrated primary production by diatom"  unit="mol/m2/s"                       />
+       <field id="INTPP"       long_name="Vertically integrated primary production by phyto"   unit="mol/m2/s"                       />
+       <field id="INTPNEW"     long_name="Vertically integrated new primary production"        unit="mol/m2/s"                       />
+       <field id="INTPBFE"     long_name="Vertically integrated of biogenic iron production"   unit="mol/m2/s"                       />
+       <field id="INTPBSI"     long_name="Vertically integrated of biogenic Si production"     unit="mol/m2/s"                       />
+       <field id="INTPCAL"     long_name="Vertically integrated of calcite production"         unit="mol/m2/s"                       />
+
+       <!-- PISCES light : variables available with key_pisces_reduced -->
+       <field id="FNO3PHY"     long_name="FNO3PHY"                                 unit=""          grid_ref="grid_T_3D" /> 
+       <field id="FNH4PHY"     long_name="FNH4PHY"                                 unit=""          grid_ref="grid_T_3D" /> 
+       <field id="FNH4NO3"     long_name="FNH4NO3"                                 unit=""          grid_ref="grid_T_3D" /> 
+       <field id="TNO3PHY"     long_name="TNO3PHY"                                 unit=""  /> 
+       <field id="TNH4PHY"     long_name="TNH4PHY"                                 unit=""  /> 
+       <field id="TPHYDOM"     long_name="TPHYDOM"                                 unit=""  /> 
+       <field id="TPHYNH4"     long_name="TPHYNH4"                                 unit=""  /> 
+       <field id="TPHYZOO"     long_name="TPHYZOO"                                 unit=""  /> 
+       <field id="TPHYDET"     long_name="TPHYDET"                                 unit=""  /> 
+       <field id="TDETZOO"     long_name="TDETZOO"                                 unit=""  /> 
+       <field id="TZOODET"     long_name="TZOODET"                                 unit=""  /> 
+       <field id="TZOOBOD"     long_name="TZOOBOD"                                 unit=""  /> 
+       <field id="TZOONH4"     long_name="TZOONH4"                                 unit=""  /> 
+       <field id="TZOODOM"     long_name="TZOODOM"                                 unit=""  /> 
+       <field id="TNH4NO3"     long_name="TNH4NO3"                                 unit=""  /> 
+       <field id="TDOMNH4"     long_name="TDOMNH4"                                 unit=""  /> 
+       <field id="TDETNH4"     long_name="TDETNH4"                                 unit=""  /> 
+       <field id="TPHYTOT"     long_name="TPHYTOT"                                 unit=""  /> 
+       <field id="TZOOTOT"     long_name="TZOOTOT"                                 unit=""  /> 
+       <field id="SEDPOC"      long_name="SEDPOC"                                  unit=""  /> 
+       <field id="TDETSED"     long_name="TDETSED"                                 unit=""  /> 
+
+       <!-- CFC11 : variables available with key_cfc -->
+       <field id="qtrCFC11"    long_name="Air-sea flux of CFC-11"                  unit="mol/m2/s"   />
+       <field id="qintCFC11"   long_name="Cumulative air-sea flux of CFC-11"       unit="mol/m2"     />
+       <!-- CFC12 : variables available with key_cfc -->
+       <field id="qtrCFC12"    long_name="Air-sea flux of CFC-12"                  unit="mol/m2/s"   />
+       <field id="qintCFC12"   long_name="Cumulative air-sea flux of CFC-12"       unit="mol/m2"     />
+       <!-- SF6 : variables available with key_cfc -->
+       <field id="qtrSF6"    long_name="Air-sea flux of SF6"                  unit="mol/m2/s"   />
+       <field id="qintSF6"   long_name="Cumulative air-sea flux of SF6"       unit="mol/m2"     />
+
+       <!-- Bomb C14 : variables available with key_c14b -->
+       <field id="qtrC14b"     long_name="Air-sea flux of Bomb C14"                unit="mol/m2/s"   />
+       <field id="qintC14b"    long_name="Cumulative air-sea flux of Bomb C14"     unit="mol/m2"     />
+       <field id="fdecay"      long_name="Radiactive decay of Bomb C14"            unit="mol/m3"  grid_ref="grid_T_3D"  />
+
+       <!-- IDTRA : variables available with key_idtra -->
+       <field id="qtrIDTRA"    long_name="Air-sea flux of Ideal Tracer"             unit="mol/m2/s"   />
+       <field id="qintIDTRA"   long_name="Cumulative air-sea flux of Ideal Tracer"  unit="mol/m2"     />
+       <field id="invIDTRA"    long_name="Vertical inventory"                       unit="mol/m2"     />
+
+       <!-- MEDUSA additional diagnostics on T grid  -->
+       <field id= "INVTN"      long_name="Column N inventory"                        unit="mmolN/m2"    />
+       <field id= "INVTSI"     long_name="Column Si inventory"                       unit="mmolSi/m2"   />
+       <field id= "INVTFE"     long_name="Column Fe inventory"                       unit="mmolFe/m2"   />
+       <field id= "PRN"        long_name="Non-diatom primary production"             unit="mmolN/m2/d"  />
+       <field id= "MPN"        long_name="Non-diatom non-grazing losses"             unit="mmolN/m2/d"  />
+       <field id= "PRD"        long_name="Diatom primary production"                 unit="mmolN/m2/d"  />
+       <field id= "MPD"        long_name="Diatom non-grazing losses"                 unit="mmolN/m2/d"  />
+       <field id= "DSED"       long_name="Gravitational sinking of Detritus"         unit="mmolN/m2/d"  />
+       <field id= "OPAL"       long_name="Diatom biogenic opal production"           unit="mmolSi/m2/d" />
+       <field id= "OPALDISS"   long_name="Diatom biogenic opal dissolution"          unit="mmolSi/m2/d" />
+       <field id= "GMIPn"      long_name="Microzoo grazing on non-diatoms"           unit="mmolN/m2/d"  />
+       <field id= "GMID"       long_name="Microzoo grazing on detritus"              unit="mmolN/m2/d"  />
+       <field id= "MZMI"       long_name="Microzoo non-grazing losses"               unit="mmolN/m2/d"  />
+       <field id= "GMEPN"      long_name="Mesozoo grazing on non-diatoms"            unit="mmolN/m2/d"  />
+       <field id= "GMEPD"      long_name="Mesozoo grazing on non-diatoms"            unit="mmolN/m2/d"  />
+       <field id= "GMEZMI"     long_name="Mesozoo grazing on microzoo"               unit="mmolN/m2/d"  />
+       <field id= "GMED"       long_name="Mesozoo grazing on detritus"               unit="mmolN/m2/d"  />
+       <field id= "MZME"       long_name="Mesozoo non-grazing losses"                unit="mmolN/m2/d"  />
+       <field id= "DEXP"       long_name="Detritus export"                           unit="mmolN/m2/d"  />
+       <field id= "DETN"       long_name="Slow detritus creation"                    unit="mmolN/m2/d"  />
+       <field id= "MDET"       long_name="Detritus non-grazing losses"               unit="MmolN/m2/d"  />
+       <field id= "AEOLIAN"    long_name="Aeolian deposition of iron"                unit="mmolFe/m2/d" />
+       <field id= "BENTHIC"    long_name="Benthic supply of iron"                    unit="mmolFe/m2/d" />
+       <field id= "SCAVENGE"   long_name="Scavenged iron"                            unit="mmolFe/m2/d" />
+       <field id= "PN_JLIM"    long_name="Non-diatom light limitation"               unit="-"           />
+       <field id= "PN_NLIM"    long_name="Non-diatom N limitation"                   unit="-"           />
+       <field id= "PN_FELIM"   long_name="Non-diatom Fe limitation"                  unit="-"           />
+       <field id= "PD_JLIM"    long_name="Diatom light limitation"                   unit="-"           />
+       <field id= "PD_NLIM"    long_name="Diatom N limitation"                       unit="-"           />
+       <field id= "PD_FELIM"   long_name="Diatom Fe limitation"                      unit="-"           />
+       <field id= "PD_SILIM"   long_name="Diatom Si limitation"                      unit="-"           />
+       <field id= "PDSILIM2"   long_name="Diatom Si uptake limitation"               unit="-"           />
+       <field id= "SDT__100"   long_name="Slow detrital flux at  100 m"              unit="mmolN/m2/d"  />
+       <field id= "SDT__200"   long_name="Slow detrital flux at  200 m"              unit="mmolN/m2/d"  />
+       <field id= "SDT__500"   long_name="Slow detrital flux at  500 m"              unit="mmolN/m2/d"  />
+       <field id= "SDT_1000"   long_name="Slow detrital flux at 1000 m"              unit="mmolN/m2/d"  />
+       <field id= "TOTREG_N"   long_name="Full column regenerated N"                 unit="mmolN/m2/d"  />
+       <field id= "TOTRG_SI"   long_name="Full column regenerated Si"                unit="mmolSi/m2/d" />
+       <field id= "REG__100"   long_name="Regenerated N to  100 m"                   unit="mmolN/m2/d"  />
+       <field id= "REG__200"   long_name="Regenerated N to  200 m"                   unit="mmolN/m2/d"  />
+       <field id= "REG__500"   long_name="Regenerated N to  500 m"                   unit="mmolN/m2/d"  />
+       <field id= "REG_1000"   long_name="Regenerated N to 1000 m"                   unit="mmolN/m2/d"  />
+       <field id= "FASTN"      long_name="Fast-sinking flux N"                       unit="mmolN/m2/d"  />
+       <field id= "FASTSI"     long_name="Fast-sinking flux Si"                      unit="mmolSi/m2/d" />
+       <field id= "FASTFE"     long_name="Fast-sinking flux Fe"                      unit="mmolFe/m2/d" />
+       <field id= "FASTC"      long_name="Fast-sinking flux C"                       unit="mmolC/m2/d"  />
+       <field id= "FASTCA"     long_name="Fast-sinking flux CaCO3"                   unit="mmolC/m2/d"  />
+       <field id= "FDT__100"   long_name="Fast detrital N flux at  100 m"            unit="mmolN/m2/d"  />
+       <field id= "FDT__200"   long_name="Fast detrital N flux at  200 m"            unit="mmolN/m2/d"  />
+       <field id= "FDT__500"   long_name="Fast detrital N flux at  500 m"            unit="mmolN/m2/d"  />
+       <field id= "FDT_1000"   long_name="Fast detrital N flux at 1000 m"            unit="mmolN/m2/d"  />
+       <field id= "RG__100F"   long_name="Regenerated fast N to  100 m"              unit="mmolN/m2/d"  />
+       <field id= "RG__200F"   long_name="Regenerated fast N to  200 m"              unit="mmolN/m2/d"  />
+       <field id= "RG__500F"   long_name="Regenerated fast N to  500 m"              unit="mmolN/m2/d"  />
+       <field id= "RG_1000F"   long_name="Regenerated fast N to 1000 m"              unit="mmolN/m2/d"  />
+       <field id= "FDS__100"   long_name="Fast detrital Si flux at  100 m"           unit="mmolSi/m2/d" />
+       <field id= "FDS__200"   long_name="Fast detrital Si flux at  200 m"           unit="mmolSi/m2/d" />
+       <field id= "FDS__500"   long_name="Fast detrital Si flux at  500 m"           unit="mmolSi/m2/d" />
+       <field id= "FDS_1000"   long_name="Fast detrital Si flux at 1000 m"           unit="mmolSi/m2/d" />
+       <field id= "RGS_100F"   long_name="Regenerated fast Si to  100 m"             unit="mmolSi/m2/d" />
+       <field id= "RGS_200F"   long_name="Regenerated fast Si to  200 m"             unit="mmolSi/m2/d" />
+       <field id= "RGS_500F"   long_name="Regenerated fast Si to  500 m"             unit="mmolSi/m2/d" />
+       <field id= "RGS1000F"   long_name="Regenerated fast Si to 1000 m"             unit="mmolSi/m2/d" />
+       <field id= "REMINN"     long_name="Fast-sinking remin flux N"                 unit="mmolN/m2/d"  />
+       <field id= "REMINSI"    long_name="Fast-sinking remin flux Si"                unit="mmolSi/m2/d" />
+       <field id= "REMINFE"    long_name="Fast-sinking remin flux Fe"                unit="mmolFe/m2/d" />
+       <field id= "REMINC"     long_name="Fast-sinking remin flux C"                 unit="mmolC/m2/d"  />
+       <field id= "REMINCA"    long_name="Fast-sinking remin flux CaCO3"             unit="mmolC/m2/d"  />
+       <field id= "SEAFLRN"    long_name="Seafloor flux of N"                        unit="mmolN/m2/d"  />
+       <field id= "SEAFLRSI"   long_name="Seafloor flux of Si"                       unit="mmolSi/m2/d" />
+       <field id= "SEAFLRFE"   long_name="Seafloor flux of Fe"                       unit="mmolFe/m2/d" />
+       <field id= "SEAFLRC"    long_name="Seafloor flux of C"                        unit="mmolC/m2/d"  />
+       <field id= "SEAFLRCA"   long_name="Seafloor flux of CaCO3"                    unit="mmolC/m2/d"  />
+       <field id= "MED_QSR"    long_name="Sea surface radiation"                     unit="W/m2"        />
+       <field id= "MED_XPAR"   long_name="Top level radiation"                       unit="W/m2"        />
+       <field id= "INTFLX_N"   long_name="Integrated N  cycle fluxes"                unit="mmolN/m2/d"  />
+       <field id= "INTFLX_SI"  long_name="Integrated Si cycle fluxes"                unit="mmolSi/m2/d" />
+       <field id= "INTFLX_FE"  long_name="Integrated Fe cycle fluxes"                unit="mmolFe/m2/d" />
+       <field id= "INT_PN"     long_name="Vertically integrated Pn"                  unit="mmolN/m2"    />
+       <field id= "INT_PD"     long_name="Vertically integrated Pd"                  unit="mmolN/m2"    />
+       <field id= "ML_PRN"     long_name="Non-diatom mixed layer PP"                 unit="mmolN/m2/d"  />
+       <field id= "ML_PRD"     long_name="Diatom mixed layer PP"                     unit="mmolN/m2/d"  />
+       <field id= "OCAL_CCD"   long_name="Calcite CCD depth"                         unit="m"           />
+       <field id= "OCAL_LVL"   long_name="Calcite CCD level"                         unit="-"           />
+       <field id= "FE_0000"    long_name="Free iron at    0m"                        unit="-"           />
+       <field id= "FE_0100"    long_name="Free iron at  100m"                        unit="-"           />
+       <field id= "FE_0200"    long_name="Free iron at  200m"                        unit="-"           />
+       <field id= "FE_0500"    long_name="Free iron at  500m"                        unit="-"           />
+       <field id= "FE_1000"    long_name="Free iron at 1000m"                        unit="-"           />
+       <field id= "MED_XZE"    long_name="Euphotic depth"                            unit="m"           />
+       <field id= "WIND"       long_name="Surface scalar wind"                       unit="m/s"         />
+       <field id= "ATM_PCO2"   long_name="Atmospheric pCO2"                          unit="uatm"        />
+       <field id= "OCN_PH"     long_name="Surface ocean pH"                          unit="-"           />
+       <field id= "OCN_PCO2"   long_name="Surface ocean pCO2"                        unit="uatm"        />
+       <field id= "OCNH2CO3"   long_name="Surface ocean H2CO3 conc"                  unit="mmolC/m3"    />
+       <field id= "OCN_HCO3"   long_name="Surface ocean HCO3 conc"                   unit="mmolC/m3"    />
+       <field id= "OCN_CO3"    long_name="Surface ocean CO3 conc"                    unit="mmolC/m3"    />
+       <field id= "CO2FLUX"    long_name="Air-sea CO2 flux"                          unit="mmolC/m2/d"  />
+       <field id= "FGCO2"      long_name="Surface Downward CO2 Flux"                 unit="kg-CO2/m2/s" />
+       <field id= "OM_CAL"     long_name="Omega calcite"                             unit="-"           />
+       <field id= "OM_ARG"     long_name="Omega aragonite"                           unit="-"           />
+       <field id= "TCO2"       long_name="Total CO2"                                 unit="umol/kg"     />
+       <field id= "TALK"       long_name="Total alkalinity"                          unit="ueq/kg"      />
+       <field id= "KW660"      long_name="Piston velocity"                           unit="m/s"         />
+       <field id= "ATM_PP0"    long_name="Atmospheric pressure"                      unit="atm"         />
+       <field id= "O2FLUX"     long_name="Air-sea O2 flux"                           unit="mmolO2/m2/d" />
+       <field id= "O2SAT"      long_name="Surface ocean O2 saturation"               unit="mmolO2/m3"   />
+       <field id= "CAL_CCD"    long_name="Calcite CCD depth"                         unit="m"           />
+       <field id= "ARG_CCD"    long_name="Aragonite CCD depth"                       unit="m"           />
+       <field id= "SFR_OCAL"   long_name="Seafloor omega calcite"                    unit="-"           />
+       <field id= "SFR_OARG"   long_name="Seafloor omega aragonite"                  unit="-"           />
+       <field id= "N_PROD"     long_name="Nitrogen production"                       unit="mmolN/m2/d"  />
+       <field id= "N_CONS"     long_name="Nitrogen consumption"                      unit="mmolN/m2/d"  />
+       <field id= "C_PROD"     long_name="Carbon production"                         unit="mmolC/m2/d"  />
+       <field id= "C_CONS"     long_name="Carbon consumption"                        unit="mmolC/m2/d"  />
+       <field id= "O2_PROD"    long_name="Oxygen production"                         unit="mmolO2/m2/d" />
+       <field id= "O2_CONS"    long_name="Oxygen consumption"                        unit="mmolO2/m2/d" />
+       <field id= "O2_ANOX"    long_name="Unrealised oxygen consumption"             unit="mmolO2/m2/d" />
+       <field id= "RR_0100"    long_name="Rain ratio at  100m"                       unit="molC/molC"   />
+       <field id= "RR_0500"    long_name="Rain ratio at  500m"                       unit="molC/molC"   />
+       <field id= "RR_1000"    long_name="Rain ratio at 1000m"                       unit="molC/molC"   />
+       <field id= "IBEN_N"     long_name="Benthic input nitrogen"                    unit="mmolN/m2/d"  />
+       <field id= "IBEN_FE"    long_name="Benthic input iron"                        unit="mmolFe/m2/d" />
+       <field id= "IBEN_C"     long_name="Benthic input carbon"                      unit="mmolC/m2/d"  />
+       <field id= "IBEN_SI"    long_name="Benthic input silicon"                     unit="mmolSi/m2/d" />
+       <field id= "IBEN_CA"    long_name="Benthic input CaCO3"                       unit="mmolC/m2/d"  />
+       <field id= "OBEN_N"     long_name="Benthic output nitrogen"                   unit="mmolN/m2/d"  />
+       <field id= "OBEN_FE"    long_name="Benthic output iron"                       unit="mmolFe/m2/d" />
+       <field id= "OBEN_C"     long_name="Benthic output carbon"                     unit="mmolC/m2/d"  />
+       <field id= "OBEN_SI"    long_name="Benthic output silicon"                    unit="mmolSi/m2/d" />
+       <field id= "OBEN_CA"    long_name="Benthic output CaCO3"                      unit="mmolC/m2/d"  />
+       <field id= "BEN_N"      long_name="Benthic nitrogen"                          unit="mmolN/m2"    />
+       <field id= "BEN_FE"     long_name="Benthic iron"                              unit="mmolFe/m2"   />
+       <field id= "BEN_C"      long_name="Benthic carbon"                            unit="mmolC/m2"    />
+       <field id= "BEN_SI"     long_name="Benthic silicon"                           unit="mmolSi/m2"   />
+       <field id= "BEN_CA"     long_name="Benthic CaCO3"                             unit="mmolC/m2"    />
+       <field id= "RUNOFF"     long_name="River runoff"                              unit="m/d"         />
+       <field id= "RIV_N"      long_name="Riverine input nitrogen"                   unit="mmolN/m2/d"  />
+       <field id= "RIV_SI"     long_name="Riverine input silicon"                    unit="mmolSi/m2/d" />
+       <field id= "RIV_C"      long_name="Riverine input carbon"                     unit="mmolSi/m2/d" />
+       <field id= "RIV_ALK"    long_name="Riverine input alkalinity"                 unit="meq/m2/d"    />
+       <field id= "DETC"       long_name="Slow detritus C creation"                  unit="mmolC/m2/d"  />
+       <field id= "SDC__100"   long_name="Slow detrital C flux at  100 m"            unit="mmolC/m2/d"  />
+       <field id= "SDC__200"   long_name="Slow detrital C flux at  200 m"            unit="mmolC/m2/d"  />
+       <field id= "SDC__500"   long_name="Slow detrital C flux at  500 m"            unit="mmolC/m2/d"  />
+       <field id= "SDC_1000"   long_name="Slow detrital C flux at 1000 m"            unit="mmolC/m2/d"  />
+       <field id= "INVTC"      long_name="Column C inventory"                        unit="mmolC/m2"    />
+       <field id= "INVTALK"    long_name="Column alkalinity inventory"               unit="meq/m2"      />
+       <field id= "INVTO2"     long_name="Column O2 inventory"                       unit="mmolO2/m2"   />
+       <field id= "LYSO_CA"    long_name="Incorrect benthic output CaCO3"            unit="mmolC/m2/d"  />
+       <field id= "COM_RESP"   long_name="Community respiration"                     unit="mmolC/m2/d"  />
+       <field id= "PN_LLOSS"   long_name="Non-diatom linear losses"                  unit="mmolN/m2/d"  />
+       <field id= "PD_LLOSS"   long_name="Diatom linear losses"                      unit="mmolN/m2/d"  />
+       <field id= "ZI_LLOSS"   long_name="Microzooplankton linear losses"            unit="mmolN/m2/d"  />
+       <field id= "ZE_LLOSS"   long_name="Mesozooplankton linear losses"             unit="mmolN/m2/d"  />
+       <field id= "ZI_MES_N"   long_name="Microzoo messy feeding loss to N"          unit="mmolN/m2/d"  />
+       <field id= "ZI_MES_D"   long_name="Microzoo messy feeding loss to D"          unit="mmolN/m2/d"  />
+       <field id= "ZI_MES_C"   long_name="Microzoo messy feeding loss to C"          unit="mmolC/m2/d"  />
+       <field id= "ZI_MESDC"   long_name="Microzoo messy feeding loss to Dc"         unit="mmolC/m2/d"  />
+       <field id= "ZI_EXCR"    long_name="Microzoo excretion"                        unit="mmolN/m2/d"  />
+       <field id= "ZI_RESP"    long_name="Microzoo respiration"                      unit="mmolC/m2/d"  />
+       <field id= "ZI_GROW"    long_name="Microzoo growth"                           unit="mmolN/m2/d"  />
+       <field id= "ZE_MES_N"   long_name="Mesozoo messy feeding loss to N"           unit="mmolN/m2/d"  />
+       <field id= "ZE_MES_D"   long_name="Mesozoo messy feeding loss to D"           unit="mmolN/m2/d"  />
+       <field id= "ZE_MES_C"   long_name="Mesozoo messy feeding loss to C"           unit="mmolC/m2/d"  />
+       <field id= "ZE_MESDC"   long_name="Mesozoo messy feeding loss to Dc"          unit="mmolC/m2/d"  />
+       <field id= "ZE_EXCR"    long_name="Mesozoo excretion"                         unit="mmolN/m2/d"  />
+       <field id= "ZE_RESP"    long_name="Mesozoo respiration"                       unit="mmolC/m2/d"  />
+       <field id= "ZE_GROW"    long_name="Mesozoo growth"                            unit="mmolN/m2/d"  />
+       <field id= "MDETC"      long_name="Detritus non-grazing losses, carbon"       unit="mmolC/m2/d"  />
+       <field id= "GMIDC"      long_name="Microzoo grazing on detritus, carbon"      unit="mmolC/m2/d"  />
+       <field id= "GMEDC"      long_name="Mesozoo  grazing on detritus, carbon"      unit="mmolC/m2/d"  />
+       <field id= "INT_ZMI"    long_name="Vertically integrated Zmi"                 unit="mmolN/m2"    />
+       <field id= "INT_ZME"    long_name="Vertically integrated Zme"                 unit="mmolN/m2"    />
+       <field id= "INT_DET"    long_name="Vertically integrated Det"                 unit="mmolN/m2"    />
+       <field id= "INT_DTC"    long_name="Vertically integrated Dtc"                 unit="mmolC/m2"    />
+       <field id= "DMS_SURF"   long_name="DMS Surface Concentration"                 unit="nmol/L"      />
+       <field id= "DMS_ANDR"   long_name="DMS Surface Concentration, Anderson"       unit="nmol/L"      />
+       <field id= "DMS_SIMO"   long_name="DMS Surface Concentration, SimoDach"       unit="nmol/L"      />
+       <field id= "DMS_ARAN"   long_name="DMS Surface Concentration, AranamiT"       unit="nmol/L"      />
+       <field id= "DMS_HALL"   long_name="DMS Surface Concentration, Halloran"       unit="nmol/L"      />
+       <field id= "DMS_ANDM"   long_name="DMS Surface Concentration, Anderson modif" unit="nmol/L"      />
+       <field id= "ATM_XCO2"   long_name="Atmospheric xCO2"                          unit="ppm"         />
+       <field id= "OCN_FCO2"   long_name="Surface ocean fCO2"                        unit="uatm"        />
+       <field id= "ATM_FCO2"   long_name="Atmospheric fCO2"                          unit="uatm"        />
+       <field id= "OCN_RHOSW"  long_name="MOCSY rhoSW"                               unit="kg/m3"       />
+       <field id= "OCN_SCHCO2" long_name="MOCSY Schmidt CO2"                         unit="-"           />
+       <field id= "OCN_KWCO2"  long_name="MOCSY kw CO2"                              unit="m/s"         />
+       <field id= "OCN_K0"     long_name="MOCSY k0"                                  unit="(mol/kg)/atm" />
+       <field id= "CO2STARAIR" long_name="MOCSY CO2star air"                         unit="mmol/m3"     />
+       <field id= "OCN_DPCO2"  long_name="MOCSY delta pCO2"                          unit="uatm"        />
+       
+
+       <!-- AXY (08/11/16): add new 2D CMIP6 diagnostics -->
+       <field id= "epC100"     long_name="Downward Flux of Particle Organic Carbon"  unit="mmolC/m2/d"  />
+       <field id= "epCALC100"  long_name="Downward Flux of Calcite"                  unit="mmolC/m2/d"  />
+       <field id= "epN100"     long_name="Downward Flux of Particulate Nitrogen"     unit="mmolN/m2/d"  />
+       <field id= "epSI100"    long_name="Downward Flux of Particulate Silica"       unit="mmolSi/m2/d" />
+       <field id= "INTDISSIC"  long_name="Dissolved Inorganic Carbon Content"        unit="mmolC/m2"    />
+       <field id= "INTDISSIN"  long_name="Dissolved Inorganic Nitrogen Content"      unit="mmolN/m2"    />
+       <field id= "INTDISSISI" long_name="Dissolved Inorganic Silicon Content"       unit="mmolSi/m2"   />
+       <field id= "INTTALK"    long_name="Dissolved Alkalinity Content"              unit="meq/m2"      />
+       <field id= "O2min"      long_name="Oxygen Minimum Concentration"              unit="mmolO2/m3"   />
+       <field id= "ZO2min"     long_name="Depth of Oxygen Minimum Concentration"     unit="m"           />
+       <field id= "FBDDTALK"   long_name="Int. change of Alkalinity due to Biology"  unit="meq/m2/d"    />
+       <field id= "FBDDTDIC"   long_name="Int. change of DI Carbon due to Biology"   unit="mmolC/m2/d"  />
+       <field id= "FBDDTDIFE"  long_name="Int. change of DI Iron due to Biology"     unit="mmolFe/m2/d" />
+       <field id= "FBDDTDIN"   long_name="Int. change of DI Nitrogen due to Biology" unit="mmolN/m2/d"  />
+       <field id= "FBDDTDISI"  long_name="Int. change of DI Silicon due to Biology"  unit="mmolSi/m2/d" />
+       
+
+       <!-- MEDUSA 3D diagnostics -->
+       <field id= "TPP3"       long_name="Total primary production 3D"               unit="mmolN/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "DETFLUX3"   long_name="Total detrital flux 3D"                    unit="mmolN/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "REMIN3N"    long_name="Total remin flux N 3D"                     unit="mmolN/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "PH3"        long_name="Ocean pH 3D"                               unit="-"             grid_ref="grid_T_3D"  />
+       <field id= "OM_CAL3"    long_name="Omega calcite 3D"                          unit="-"             grid_ref="grid_T_3D"  />
+
+       <!-- AXY (08/11/16): add new 3D CMIP6 diagnostics -->
+       <field id= "TPPD3"      long_name="Diatom primary production 3D"              unit="mmolN/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "BDDTALK3"   long_name="Change of Alkalinity due to Biology"       unit="meq/m3/d"      grid_ref="grid_T_3D"  />
+       <field id= "BDDTDIC3"   long_name="Change of DI Carbon due to Biology"        unit="mmolC/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "BDDTDIFE3"  long_name="Change of DI Iron due to Biology"          unit="mmolFe/m3/d"   grid_ref="grid_T_3D"  />
+       <field id= "BDDTDIN3"   long_name="Change of DI Nitrogen due to Biology"      unit="mmolN/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "BDDTDISI3"  long_name="Change of DI Silicon due to Biology"       unit="mmolSi/m3/d"   grid_ref="grid_T_3D"  />
+       <field id= "FD_NIT3"    long_name="Fast sinking detrital nitrogen"            unit="mmolN/m2/d"    grid_ref="grid_T_3D"  />
+       <field id= "FD_SIL3"    long_name="Fast sinking detrital silicon"             unit="mmolSi/m2/d"   grid_ref="grid_T_3D"  />
+       <field id= "FD_CAR3"    long_name="Fast sinking detrital carbon"              unit="mmolC/m2/d"    grid_ref="grid_T_3D"  />
+       <field id= "FD_CAL3"    long_name="Fast sinking detrital calcium carbonate"   unit="mmolC/m2/d"    grid_ref="grid_T_3D"  />
+       <field id= "CO33"       long_name="Carbonate ion concentration"               unit="mmolC/m3"      grid_ref="grid_T_3D"  />
+       <field id= "CO3SATARAG3" long_name="Carbonate aragonite saturation conc"      unit="mmolC/m3"      grid_ref="grid_T_3D"  />
+       <field id= "CO3SATCALC3" long_name="Carbonate calcite saturation conc"        unit="mmolC/m3"      grid_ref="grid_T_3D"  />
+       <field id= "DCALC3"     long_name="Calcite dissolution"                       unit="mmolC/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "EXPC3"      long_name="Downward Flux of Particulate Org Carbon"   unit="mmolC/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "EXPN3"      long_name="Downward Flux of Particulate Org Nitrogen" unit="mmolN/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "FEDISS3"    long_name="Particle Source of Dissolved Iron"         unit="mmolFe/m3/d"   grid_ref="grid_T_3D"  />
+       <field id= "FESCAV3"    long_name="Nonbiogenic Iron Scavenging"               unit="mmolFe/m3/d"   grid_ref="grid_T_3D"  />
+       <field id= "MIGRAZP3"   long_name="Microzooplankton grazing on phytoplankton" unit="mmolC/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "MIGRAZD3"   long_name="Microzooplankton grazing on detritus"      unit="mmolC/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "MEGRAZP3"   long_name="Mesozooplankton grazing on phytoplankton"  unit="mmolC/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "MEGRAZD3"   long_name="Mesozooplankton grazing on detritus"       unit="mmolC/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "MEGRAZZ3"   long_name="Mesozooplankton grazing on microzoop"      unit="mmolC/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "O2SAT3"     long_name="Dissolved Oxygen Saturation Concentration" unit="mmolO2/m3"     grid_ref="grid_T_3D"  />
+       <field id= "PBSI3"      long_name="Biogenic Silica Production"                unit="mmolSi/m3/d"   grid_ref="grid_T_3D"  />
+       <field id= "PCAL3"      long_name="Biogenic Calcite Production"               unit="mmolC/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "REMOC3"     long_name="Remineralization of Organic Carbon"        unit="mmolC/m3/d"    grid_ref="grid_T_3D"  />
+       <field id= "PNLIMJ3"    long_name="Irradiance limitation of non-diatoms"      unit="-"             grid_ref="grid_T_3D"  />
+       <field id= "PNLIMN3"    long_name="Nitrogen limitation of non-diatoms"        unit="-"             grid_ref="grid_T_3D"  />
+       <field id= "PNLIMFE3"   long_name="Iron limitation of non-diatoms"            unit="-"             grid_ref="grid_T_3D"  />
+       <field id= "PDLIMJ3"    long_name="Irradiance limitation of diatoms"          unit="-"             grid_ref="grid_T_3D"  />
+       <field id= "PDLIMN3"    long_name="Nitrogen limitation of diatoms"            unit="-"             grid_ref="grid_T_3D"  />
+       <field id= "PDLIMFE3"   long_name="Iron limitation of diatoms"                unit="-"             grid_ref="grid_T_3D"  />
+       <field id= "PDLIMSI3"   long_name="Silicon limitation of diatoms"             unit="-"             grid_ref="grid_T_3D"  />
+
+     </field_group>
+
+     <field_group id="PISCES_scalar"  domain_ref="1point" >
+       <field id="pno3tot"         long_name="global mean nitrate concentration"                  unit="mol/m3"   />
+       <field id="ppo4tot"         long_name="global mean phosphorus concentration"               unit="mol/m3"   />
+       <field id="psiltot"         long_name="global mean silicate concentration"                 unit="mol/m3"   />
+       <field id="palktot"         long_name="global mean alkalinity concentration"               unit="mol/m3"   />
+       <field id="pfertot"         long_name="global mean iron concentration"                     unit="mol/m3"   />
+       <field id="tcflx"           long_name="total Flux of Carbon out of the ocean"              unit="mol/s"   />
+       <field id="tcflxcum"        long_name="cumulative total Flux of Carbon out of the ocean"   unit="mol/s"   />
+       <field id="tcexp"           long_name="total Carbon export at 100m"                        unit="mol/s"   />
+       <field id="tintpp"          long_name="global total integrated primary production"         unit="mol/s"   />
+       <field id="tnfix"           long_name="global total nitrogen fixation"                     unit="mol/s"   />
+       <field id="tdenit"          long_name="Total denitrification"                              unit="mol/s"   />
+     </field_group>
+
+    <!-- 
+============================================================================================================
+                                        Definitions for iodef_demo.xml
+============================================================================================================
+    -->
+
+    <field_group id="groupMEDUSA" >
+      <field field_ref="CHN"     name="CHN"      />
+      <field field_ref="CHN_E3T" name="CHN_E3T"  />
+      <field field_ref="CHD"     name="CHD"      />
+      <field field_ref="CHD_E3T" name="CHD_E3T"  />
+      <field field_ref="PHN"     name="PHN"      />
+      <field field_ref="PHN_E3T" name="PHN_E3T"  />
+      <field field_ref="PHD"     name="PHD"      />
+      <field field_ref="PHD_E3T" name="PHD_E3T"  />
+      <field field_ref="ZMI"     name="ZMI"      />
+      <field field_ref="ZMI_E3T" name="ZMI_E3T"  />
+      <field field_ref="ZME"     name="ZME"      />
+      <field field_ref="ZME_E3T" name="ZME_E3T"  />
+      <field field_ref="DIN"     name="DIN"      />
+      <field field_ref="DIN_E3T" name="DIN_E3T"  />
+      <field field_ref="SIL"     name="SIL"      />
+      <field field_ref="SIL_E3T" name="SIL_E3T"  />
+      <field field_ref="FER"     name="FER"      />
+      <field field_ref="FER_E3T" name="FER_E3T"  />
+      <field field_ref="DET"     name="DET"      />
+      <field field_ref="DET_E3T" name="DET_E3T"  />
+      <field field_ref="PDS"     name="PDS"      />
+      <field field_ref="PDS_E3T" name="PDS_E3T"  />
+      <field field_ref="DTC"     name="DTC"      />
+      <field field_ref="DTC_E3T" name="DTC_E3T"  />
+      <field field_ref="DiC"     name="DIC"      />
+      <field field_ref="DiC_E3T" name="DIC_E3T"  />
+      <field field_ref="ALK"     name="ALK"      />
+      <field field_ref="ALK_E3T" name="ALK_E3T"  />
+      <field field_ref="OXY"     name="OXY"      />
+      <field field_ref="OXY_E3T" name="OXY_E3T"  />
+      </field_group>
+
+    <field_group id="groupIDTRA" >
+      <field field_ref="IDTRA" name="IDTRA" />
+    </field_group>
+
+    <field_group id="groupIDTRA_dia" >
+      <field field_ref="qtrIDTRA"    name="qtrIDTRA"  />
+      <field field_ref="qintIDTRA"   name="qintIDTRA" />
+      <field field_ref="invIDTRA"    name="invIDTRA"  />
+    </field_group>
+
+    <field_group id="groupCFC" >
+      <field field_ref="CFC11"     name="CFC11"     />
+      <field field_ref="CFC11_E3T" name="CFC11_E3T" />
+      <field field_ref="CFC12"     name="CFC12"     />
+      <field field_ref="CFC12_E3T" name="CFC12_E3T" />
+      <field field_ref="SF6"       name="SF6"       />
+      <field field_ref="SF6_E3T"   name="SF6_E3T"   />
+    </field_group>
+
+    <field_group id="groupCFC_dia" >
+      <field field_ref="qtrCFC11"    name="qtrCFC11"   />
+      <field field_ref="qintCFC11"   name="qintCFC11"  />
+      <field field_ref="qtrCFC12"    name="qtrCFC12"   />
+      <field field_ref="qintCFC12"   name="qintCFC12"  />
+      <field field_ref="qtrSF6"      name="qtrSF6"     />
+      <field field_ref="qintSF6"     name="qintSF6"    />
+    </field_group>
+
+    <field_group id="groupAGE" >
+      <field field_ref="Age" name="Age" />
+    </field_group>
+
+    <field_group id="groupMEDUSA_dia" >
+      <field field_ref= "INVTN"      name="INVTN"      />
+      <field field_ref= "INVTSI"     name="INVTSI"     />
+      <field field_ref= "INVTFE"     name="INVTFE"     />
+      <field field_ref= "PRN"        name="PRN"        />
+      <field field_ref= "MPN"        name="MPN"        />
+      <field field_ref= "PRD"        name="PRD"        />
+      <field field_ref= "MPD"        name="MPD"        />
+      <field field_ref= "OPAL"       name="OPAL"       />
+      <field field_ref= "OPALDISS"   name="OPALDISS"   />
+      <field field_ref= "GMIPn"      name="GMIPn"      />
+      <field field_ref= "GMID"       name="GMID"       />
+      <field field_ref= "MZMI"       name="MZMI"       />
+      <field field_ref= "GMEPN"      name="GMEPN"      />
+      <field field_ref= "GMEPD"      name="GMEPD"      />
+      <field field_ref= "GMEZMI"     name="GMEZMI"     />
+      <field field_ref= "GMED"       name="GMED"       />
+      <field field_ref= "MZME"       name="MZME"       />
+      <field field_ref= "DETN"       name="DETN"       />
+      <field field_ref= "MDET"       name="MDET"       />
+      <field field_ref= "AEOLIAN"    name="AEOLIAN"    />
+      <field field_ref= "BENTHIC"    name="BENTHIC"    />
+      <field field_ref= "SCAVENGE"   name="SCAVENGE"   />
+      <field field_ref= "PN_JLIM"    name="PN_JLIM"    />
+      <field field_ref= "PN_NLIM"    name="PN_NLIM"    />
+      <field field_ref= "PN_FELIM"   name="PN_FELIM"   />
+      <field field_ref= "PD_JLIM"    name="PD_JLIM"    />
+      <field field_ref= "PD_NLIM"    name="PD_NLIM"    />
+      <field field_ref= "PD_FELIM"   name="PD_FELIM"   />
+      <field field_ref= "PD_SILIM"   name="PD_SILIM"   />
+      <field field_ref= "PDSILIM2"   name="PDSILIM2"   />
+      <field field_ref= "SDT__100"   name="SDT__100"   />
+      <field field_ref= "SDT__200"   name="SDT__200"   />
+      <field field_ref= "SDT__500"   name="SDT__500"   />
+      <field field_ref= "SDT_1000"   name="SDT_1000"   />
+      <field field_ref= "TOTREG_N"   name="TOTREG_N"   />
+      <field field_ref= "TOTRG_SI"   name="TOTRG_SI"   />
+      <field field_ref= "REG__100"   name="REG__100"   />
+      <field field_ref= "REG__200"   name="REG__200"   />
+      <field field_ref= "REG__500"   name="REG__500"   />
+      <field field_ref= "REG_1000"   name="REG_1000"   />
+      <field field_ref= "FASTN"      name="FASTN"      />
+      <field field_ref= "FASTSI"     name="FASTSI"     />
+      <field field_ref= "FASTFE"     name="FASTFE"     />
+      <field field_ref= "FASTC"      name="FASTC"      />
+      <field field_ref= "FASTCA"     name="FASTCA"     />
+      <field field_ref= "FDT__100"   name="FDT__100"   />
+      <field field_ref= "FDT__200"   name="FDT__200"   />
+      <field field_ref= "FDT__500"   name="FDT__500"   />
+      <field field_ref= "FDT_1000"   name="FDT_1000"   /> 
+      <field field_ref= "RG__100F"   name="RG__100F"   />
+      <field field_ref= "RG__200F"   name="RG__200F"   />
+      <field field_ref= "RG__500F"   name="RG__500F"   />
+      <field field_ref= "RG_1000F"   name="RG_1000F"   />
+      <field field_ref= "FDS__100"   name="FDS__100"   />
+      <field field_ref= "FDS__200"   name="FDS__200"   />
+      <field field_ref= "FDS__500"   name="FDS__500"   />
+      <field field_ref= "FDS_1000"   name="FDS_1000"   />
+      <field field_ref= "RGS_100F"   name="RGS_100F"   />
+      <field field_ref= "RGS_200F"   name="RGS_200F"   />
+      <field field_ref= "RGS_500F"   name="RGS_500F"   />
+      <field field_ref= "RGS1000F"   name="RGS1000F"   />
+      <field field_ref= "REMINN"     name="REMINN"     />
+      <field field_ref= "REMINSI"    name="REMINSI"    />
+      <field field_ref= "REMINFE"    name="REMINFE"    />
+      <field field_ref= "SEAFLRN"    name="SEAFLRN"    /> 
+      <field field_ref= "SEAFLRSI"   name="SEAFLRSI"   />
+      <field field_ref= "SEAFLRFE"   name="SEAFLRFE"   />
+      <field field_ref= "SEAFLRC"    name="SEAFLRC"    />
+      <field field_ref= "SEAFLRCA"   name="SEAFLRCA"   />
+      <field field_ref= "MED_QSR"    name="MED_QSR"    />
+      <field field_ref= "MED_XPAR"   name="MED_XPAR"   />
+      <field field_ref= "INTFLX_N"   name="INTFLX_N"   />
+      <field field_ref= "INTFLX_SI"  name="INTFLX_SI"  />
+      <field field_ref= "INTFLX_FE"  name="INTFLX_FE"  />
+      <field field_ref= "INT_PN"     name="INT_PN"     />
+      <field field_ref= "INT_PD"     name="INT_PD"     />
+      <field field_ref= "ML_PRN"     name="ML_PRN"     />
+      <field field_ref= "ML_PRD"     name="ML_PRD"     />
+      <field field_ref= "OCAL_CCD"   name="OCAL_CCD"   />
+      <field field_ref= "OCAL_LVL"   name="OCAL_LVL"   />
+      <field field_ref= "FE_0000"    name="FE_0000"    />
+      <field field_ref= "FE_0100"    name="FE_0100"    />
+      <field field_ref= "FE_0200"    name="FE_0200"    /> 
+      <field field_ref= "FE_0500"    name="FE_0500"    />
+      <field field_ref= "FE_1000"    name="FE_1000"    />
+      <field field_ref= "MED_XZE"    name="MED_XZE"    />
+      <field field_ref= "WIND"       name="WIND"       />
+      <field field_ref= "ATM_PCO2"   name="ATM_PCO2"   />
+      <field field_ref= "OCN_PH"     name="OCN_PH"     />
+      <field field_ref= "OCN_PCO2"   name="OCN_PCO2"   />
+      <field field_ref= "OCNH2CO3"   name="OCNH2CO3"   />
+      <field field_ref= "OCN_HCO3"   name="OCN_HCO3"   />
+      <field field_ref= "OCN_CO3"    name="OCN_CO3"    />
+      <field field_ref= "CO2FLUX"    name="CO2FLUX"    />
+      <field field_ref= "FGCO2"      name="FGCO2"      />
+      <field field_ref= "OM_CAL"     name="OM_CAL"     />
+      <field field_ref= "OM_ARG"     name="OM_ARG"     />
+      <field field_ref= "TCO2"       name="TCO2"       />
+      <field field_ref= "TALK"       name="TALK"       />
+      <field field_ref= "KW660"      name="KW660"      />
+      <field field_ref= "ATM_PP0"    name="ATM_PP0"    />
+      <field field_ref= "O2FLUX"     name="O2FLUX"     />
+      <field field_ref= "O2SAT"      name="O2SAT"      />
+      <field field_ref= "CAL_CCD"    name="CAL_CCD"    />
+      <field field_ref= "ARG_CCD"    name="ARG_CCD"    />
+      <field field_ref= "SFR_OCAL"   name="SFR_OCAL"   />
+      <field field_ref= "SFR_OARG"   name="SFR_OARG"   />
+      <field field_ref= "N_PROD"     name="N_PROD"     />
+      <field field_ref= "N_CONS"     name="N_CONS"     />
+      <field field_ref= "C_PROD"     name="C_PROD"     />
+      <field field_ref= "C_CONS"     name="C_CONS"     />
+      <field field_ref= "O2_PROD"    name="O2_PROD"    />
+      <field field_ref= "O2_CONS"    name="O2_CONS"    />
+      <field field_ref= "O2_ANOX"    name="O2_ANOX"    />
+      <field field_ref= "RR_0100"    name="RR_0100"    />
+      <field field_ref= "RR_0500"    name="RR_0500"    />
+      <field field_ref= "RR_1000"    name="RR_1000"    />
+      <field field_ref= "IBEN_N"     name="IBEN_N"     />
+      <field field_ref= "IBEN_FE"    name="IBEN_FE"    />
+      <field field_ref= "IBEN_C"     name="IBEN_C"     />
+      <field field_ref= "IBEN_SI"    name="IBEN_SI"    />
+      <field field_ref= "IBEN_CA"    name="IBEN_CA"    />
+      <field field_ref= "OBEN_N"     name="OBEN_N"     />
+      <field field_ref= "OBEN_FE"    name="OBEN_FE"    />
+      <field field_ref= "OBEN_C"     name="OBEN_C"     />
+      <field field_ref= "OBEN_SI"    name="OBEN_SI"    />
+      <field field_ref= "OBEN_CA"    name="OBEN_CA"    />
+      <field field_ref= "BEN_N"      name="BEN_N"      />
+      <field field_ref= "BEN_FE"     name="BEN_FE"     />
+      <field field_ref= "BEN_C"      name="BEN_C"      />
+      <field field_ref= "BEN_SI"     name="BEN_SI"     />
+      <field field_ref= "BEN_CA"     name="BEN_CA"     />
+      <field field_ref= "DETC"       name="DETC"       />
+      <field field_ref= "SDC__100"   name="SDC__100"   />
+      <field field_ref= "SDC__200"   name="SDC__200"   />
+      <field field_ref= "SDC__500"   name="SDC__500"   />
+      <field field_ref= "SDC_1000"   name="SDC_1000"   />
+      <field field_ref= "INVTC"      name="INVTC"      />
+      <field field_ref= "INVTALK"    name="INVTALK"    />
+      <field field_ref= "INVTO2"     name="INVTO2"     />
+      <field field_ref= "LYSO_CA"    name="LYSO_CA"    />
+      <field field_ref= "COM_RESP"   name="COM_RESP"   />
+      <field field_ref= "PN_LLOSS"   name="PN_LLOSS"   />
+      <field field_ref= "PD_LLOSS"   name="PD_LLOSS"   />
+      <field field_ref= "ZI_LLOSS"   name="ZI_LLOSS"   />
+      <field field_ref= "ZE_LLOSS"   name="ZE_LLOSS"   />
+      <field field_ref= "ZI_MES_N"   name="ZI_MES_N"   />
+      <field field_ref= "ZI_MES_D"   name="ZI_MES_D"   />
+      <field field_ref= "ZI_MES_C"   name="ZI_MES_C"   />
+      <field field_ref= "ZI_MESDC"   name="ZI_MESDC"   />
+      <field field_ref= "ZI_EXCR"    name="ZI_EXCR"    />
+      <field field_ref= "ZI_RESP"    name="ZI_RESP"    />
+      <field field_ref= "ZI_GROW"    name="ZI_GROW"    />
+      <field field_ref= "ZE_MES_N"   name="ZE_MES_N"   />
+      <field field_ref= "ZE_MES_D"   name="ZE_MES_D"   />
+      <field field_ref= "ZE_MES_C"   name="ZE_MES_C"   />
+      <field field_ref= "ZE_MESDC"   name="ZE_MESDC"   />
+      <field field_ref= "ZE_EXCR"    name="ZE_EXCR"    />
+      <field field_ref= "ZE_RESP"    name="ZE_RESP"    />
+      <field field_ref= "ZE_GROW"    name="ZE_GROW"    />
+      <field field_ref= "MDETC"      name="MDETC"      />
+      <field field_ref= "GMIDC"      name="GMIDC"      />
+      <field field_ref= "GMEDC"      name="GMEDC"      />
+      <field field_ref= "INT_ZMI"    name="INT_ZMI"    />
+      <field field_ref= "INT_ZME"    name="INT_ZME"    />
+      <field field_ref= "INT_DET"    name="INT_DET"    />
+      <field field_ref= "INT_DTC"    name="INT_DTC"    />
+      <field field_ref= "ATM_XCO2"   name="ATM_XCO2"   />
+      <field field_ref= "OCN_FCO2"   name="OCN_FCO2"   />
+      <field field_ref= "ATM_FCO2"   name="ATM_FCO2"   />
+      <field field_ref= "OCN_RHOSW"  name="OCN_RHOSW"  />
+      <field field_ref= "OCN_SCHCO2" name="OCN_SCHCO2" />
+      <field field_ref= "OCN_KWCO2"  name="OCN_KWCO2"  />
+      <field field_ref= "OCN_K0"     name="OCN_K0"     />
+      <field field_ref= "CO2STARAIR" name="CO2STARAIR" />
+      <field field_ref= "OCN_DPCO2"  name="OCN_DPCO2"  />
+    </field_group>
+
+    <field_group id="groupMEDUSA_3dd" >
+      <field field_ref= "TPP3"       name="TPP3"       />
+      <field field_ref= "DETFLUX3"   name="DETFLUX3"   />
+      <field field_ref= "REMIN3N"    name="REMIN3N"    />
+      <field field_ref= "PH3"        name="PH3"        />
+      <field field_ref= "OM_CAL3"    name="OM_CAL3"    /> 
+    </field_group>
+
+    <field_group id="groupMEDUSA_dms" >
+      <field field_ref= "DMS_SURF"   name="DMS_SURF"   />
+      <field field_ref= "DMS_ANDR"   name="DMS_ANDR"   />
+      <field field_ref= "DMS_SIMO"   name="DMS_SIMO"   />
+      <field field_ref= "DMS_ARAN"   name="DMS_ARAN"   />
+      <field field_ref= "DMS_HALL"   name="DMS_HALL"   />
+      <field field_ref= "DMS_ANDM"   name="DMS_ANDM"   />
+    </field_group>
+
+    <field_group id="groupMEDUSA_riv" >
+      <field field_ref= "RUNOFF"     name="RUNOFF"     />
+      <field field_ref= "RIV_N"      name="RIV_N"      />
+      <field field_ref= "RIV_SI"     name="RIV_SI"     />
+      <field field_ref= "RIV_C"      name="RIV_C"      />
+      <field field_ref= "RIV_ALK"    name="RIV_ALK"    />
+    </field_group>
+
+    <field_group id="groupMEDUSA_cmip6" >
+      <field field_ref= "epC100"     name="epC100"     />
+      <field field_ref= "epCALC100"  name="epCALC100"  />
+      <field field_ref= "epN100"     name="epN100"     />
+      <field field_ref= "epSI100"    name="epSI100"    />
+      <field field_ref= "INTDISSIC"  name="INTDISSIC"  />
+      <field field_ref= "INTDISSIN"  name="INTDISSIN"  />
+      <field field_ref= "INTDISSISI" name="INTDISSISI" />
+      <field field_ref= "INTTALK"    name="INTTALK"    />
+      <field field_ref= "O2min"      name="O2min"      />
+      <field field_ref= "ZO2min"     name="ZO2min"     />
+      <field field_ref= "FBDDTALK"   name="FBDDTALK"   />
+      <field field_ref= "FBDDTDIC"   name="FBDDTDIC"   />
+      <field field_ref= "FBDDTDIFE"  name="FBDDTDIFE"  />
+      <field field_ref= "FBDDTDIN"   name="FBDDTDIN"   />
+      <field field_ref= "FBDDTDISI"  name="FBDDTDISI"  />
+      <field field_ref= "TPPD3"      name="TPPD3"      />
+      <field field_ref= "BDDTALK3"   name="BDDTALK3"   />
+      <field field_ref= "BDDTDIC3"   name="BDDTDIC3"   />
+      <field field_ref= "BDDTDIFE3"  name="BDDTDIFE3"  />
+      <field field_ref= "BDDTDIN3"   name="BDDTDIN3"   />
+      <field field_ref= "BDDTDISI3"  name="BDDTDISI3"  />
+      <field field_ref= "FD_NIT3"    name="FD_NIT3"    />
+      <field field_ref= "FD_SIL3"    name="FD_SIL3"    />
+      <field field_ref= "FD_CAR3"    name="FD_CAR3"    />
+      <field field_ref= "FD_CAL3"    name="FD_CAL3"    />
+      <field field_ref= "CO33"       name="CO33"       />
+      <field field_ref= "CO3SATARAG3" name="CO3SATARAG3" />
+      <field field_ref= "CO3SATCALC3" name="CO3SATCALC3" />
+      <field field_ref= "DCALC3"     name="DCALC3"     />
+      <field field_ref= "EXPC3"      name="EXPC3"      />
+      <field field_ref= "EXPN3"      name="EXPN3"      />
+      <field field_ref= "FEDISS3"    name="FEDISS3"    />
+      <field field_ref= "FESCAV3"    name="FESCAV3"    />
+      <field field_ref= "MIGRAZP3"   name="MIGRAZP3"   />
+      <field field_ref= "MIGRAZD3"   name="MIGRAZD3"   />
+      <field field_ref= "MEGRAZP3"   name="MEGRAZP3"   />
+      <field field_ref= "MEGRAZD3"   name="MEGRAZD3"   />
+      <field field_ref= "MEGRAZZ3"   name="MEGRAZZ3"   />
+      <field field_ref= "O2SAT3"     name="O2SAT3"     />
+      <field field_ref= "PBSI3"      name="PBSI3"      />
+      <field field_ref= "PCAL3"      name="PCAL3"      />
+      <field field_ref= "REMOC3"     name="REMOC3"     />
+      <field field_ref= "PNLIMJ3"    name="PNLIMJ3"    />
+      <field field_ref= "PNLIMN3"    name="PNLIMN3"    />
+      <field field_ref= "PNLIMFE3"   name="PNLIMFE3"   />
+      <field field_ref= "PDLIMJ3"    name="PDLIMJ3"    />
+      <field field_ref= "PDLIMN3"    name="PDLIMN3"    />
+      <field field_ref= "PDLIMFE3"   name="PDLIMFE3"   />
+      <field field_ref= "PDLIMSI3"   name="PDLIMSI3"   />
+    </field_group>
+
+</field_definition>
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/field_def_dyn.xml
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/field_def_dyn.xml	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/field_def_dyn.xml	(revision 8201)
@@ -0,0 +1,1208 @@
+<!--
+< GO6.0 version of the XIOS namelist >
+< XIOS2 version namelist >
+
+<?xml version="1.0"?>
+       -->
+ 
+    <!-- $id$ -->
+    
+    <!-- 
+============================================================================================================
+=                                  definition of all existing variables                                    =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+   <field_definition level="1" prec="4" operation="average" enabled=".TRUE." default_value="1.e20" detect_missing_value="true"> <!-- time step automaticaly defined -->
+
+    <!-- 
+         ============================================================================================================
+                                  Physical ocean and ice model variables
+============================================================================================================
+    -->
+
+      <!-- T grid -->
+
+      <field_group id="grid_T" grid_ref="grid_T_2D" >
+         <field id="e3t"          long_name="Ocean Model cell Thickness"   standard_name="cell_thickness"   unit="m"   grid_ref="grid_T_3D"/>
+         <field id="e3t_surf"     field_ref="e3t"  long_name="T-cell thickness: surface layer"   standard_name="cell_thickness"   unit="m"  grid_ref="grid_T_surface_extract"/>
+         <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="Sea Water Potential Temperature"         standard_name="sea_water_potential_temperature"   unit="degree_C"     grid_ref="grid_T_3D"/>
+         <field id="toce_e3t"     long_name="temperature * e3t"                                                     unit="degree_C*m"   grid_ref="grid_T_3D" > toce * e3t </field >
+         <field id="toce2_e3t"    long_name="temperature squared * e3t"                                             unit="degC*degC*m"   grid_ref="grid_T_3D" > toce * toce * e3t </field >
+         <field id="soce"         long_name="Sea Water Salinity"            standard_name="sea_water_salinity"      unit="0.001"     grid_ref="grid_T_3D"/>
+         <field id="soce_e3t"     long_name="salinity * e3t"                                                        unit="0.001*m"   grid_ref="grid_T_3D" > soce * e3t </field >
+         <field id="soce2_e3t"    long_name="salinity squared * e3t"                                                unit="1e-3*1e-3*m"   grid_ref="grid_T_3D" > soce * soce * e3t </field >
+         <field id="toce_e3t_vsum" field_ref="toce_e3t" grid_ref="vert_sum" />
+         <field id="e3t_vsum" field_ref="e3t" grid_ref="vert_sum" />
+         <field id="toce_vmean" field_ref="toce_e3t_vsum" grid_ref="vert_sum"> toce_e3t_vsum/e3t_vsum </field>
+         <field id="toce_e3t_300" field_ref="toce_e3t"  unit="degree_C*m"   grid_ref="zoom_300" />
+         <field id="e3t_300" field_ref="e3t"  unit="degree_C*m"   grid_ref="zoom_300" />
+         <field id="toce_e3t_vsum300" field_ref="toce_e3t_300" grid_ref="zoom_300_sum" />
+         <field id="e3t_vsum300" field_ref="e3t_300" grid_ref="zoom_300_sum" />
+         <field id="toce_vmean300" field_ref="toce_e3t_vsum300" grid_ref="zoom_300_sum"> toce_e3t_vsum300/e3t_vsum300 </field>
+
+         <field id="sst"          long_name="Sea Surface Temperature"             standard_name="sea_surface_temperature"             unit="degree_C"     />
+         <field id="sst2"         long_name="Square of Sea Surface Temperature"   standard_name="square_of_sea_surface_temperature"   unit="degree_C2"     > sst * sst </field >
+         <field id="sstmax"       long_name="max of sea surface temperature"   field_ref="sst"   operation="maximum"                                  />
+         <field id="sstmin"       long_name="min of sea surface temperature"   field_ref="sst"   operation="minimum"                                  />
+         <field id="sstgrad"      long_name="module of sst gradient"                                                                  unit="degree_C/m"   />
+         <field id="sstgrad2"     long_name="square of module of sst gradient"                                                        unit="degree_C2/m2" />
+         <field id="sbt"          long_name="sea bottom temperature"                                                                  unit="degree_C"     />
+         <field id="tosmint"      long_name="vertical integral of temperature times density"   standard_name="integral_wrt_depth_of_product_of_density_and_potential_temperature"  unit="(kg m2) degree_C" />
+
+         <field id="sss"          long_name="Sea Surface Salinity"             standard_name="sea_surface_salinity"   unit="0.001" />
+         <field id="sss2"         long_name="square of sea surface salinity"                                          unit="1e-6"  > sss * sss </field >
+         <field id="sssmax"       long_name="max of sea surface salinity"   field_ref="sss"   operation="maximum"                 />
+         <field id="sssmin"       long_name="min of sea surface salinity"   field_ref="sss"   operation="minimum"                 />
+         <field id="sbs"          long_name="sea bottom salinity"                                                     unit="0.001" />
+         <field id="somint"       long_name="vertical integral of salinity times density"   standard_name="integral_wrt_depth_of_product_of_density_and_salinity"  unit="(kg m2) x (1e-3)" />
+
+         <field id="taubot"       long_name="bottom stress module"                                                    unit="N/m2" />              
+
+         <field id="ssh"          long_name="sea surface height"             standard_name="sea_surface_height_above_geoid"             unit="m" />
+         <field id="ssh2"         long_name="square of sea surface height"   standard_name="square_of_sea_surface_height_above_geoid"   unit="m2" > ssh * ssh </field >
+         <field id="sshmax"       long_name="max of sea surface height"   field_ref="ssh"   operation="maximum"                                  />
+
+         <field id="mldkz5"       long_name="Turbocline depth (Kz = 5e-4)"                       standard_name="ocean_mixed_layer_thickness_defined_by_vertical_tracer_diffusivity"                unit="m"          />
+         <field id="mldr10_1"     long_name="Mixed Layer Depth (dsigma = 0.01 wrt 10m)"          standard_name="ocean_mixed_layer_thickness_defined_by_sigma_theta"                                unit="m"          />
+         <field id="mldr10_1max"  long_name="Max of Mixed Layer Depth (dsigma = 0.01 wrt 10m)"   field_ref="mldr10_1"   operation="maximum"                                                                          />
+         <field id="mldr10_1min"  long_name="Min of Mixed Layer Depth (dsigma = 0.01 wrt 10m)"   field_ref="mldr10_1"   operation="minimum"                                                                          />
+         <field id="mldzint_1"    long_name="Mixed Layer Depth interpolated"                     standard_name="ocean_mixed_layer_thickness"                                                       unit="m"          />
+         <field id="mldzint_2"    long_name="Mixed Layer Depth interpolated"                     standard_name="ocean_mixed_layer_thickness"                                                       unit="m"          />
+         <field id="mldzint_3"    long_name="Mixed Layer Depth interpolated"                     standard_name="ocean_mixed_layer_thickness"                                                       unit="m"          />
+         <field id="mldzint_4"    long_name="Mixed Layer Depth interpolated"                     standard_name="ocean_mixed_layer_thickness"                                                       unit="m"          />
+         <field id="mldzint_5"    long_name="Mixed Layer Depth interpolated"                     standard_name="ocean_mixed_layer_thickness"                                                       unit="m"          />
+         <field id="mldhtc_1"     long_name="Mixed Layer Depth integrated heat content"          standard_name="integral_of_sea_water_potential_temperature_wrt_depth_expressed_as_heat_content"   unit="J/m2"       />
+         <field id="mldhtc_2"     long_name="Mixed Layer Depth integrated heat content"          standard_name="integral_of_sea_water_potential_temperature_wrt_depth_expressed_as_heat_content"   unit="J/m2"       />
+         <field id="mldhtc_3"     long_name="Mixed Layer Depth integrated heat content"          standard_name="integral_of_sea_water_potential_temperature_wrt_depth_expressed_as_heat_content"   unit="J/m2"       />
+         <field id="mldhtc_4"     long_name="Mixed Layer Depth integrated heat content"          standard_name="integral_of_sea_water_potential_temperature_wrt_depth_expressed_as_heat_content"   unit="J/m2"       />
+         <field id="mldhtc_5"     long_name="Mixed Layer Depth integrated heat content"          standard_name="integral_of_sea_water_potential_temperature_wrt_depth_expressed_as_heat_content"   unit="J/m2"       />
+         <field id="heatc"        long_name="Heat content vertically integrated"                 standard_name="integral_of_sea_water_potential_temperature_wrt_depth_expressed_as_heat_content"   unit="J/m2"       />
+         <field id="saltc"        long_name="Salt content vertically integrated"                                                                                                                   unit="0.001*kg/m2" />
+
+         <!-- EOS -->
+         <field id="alpha"        long_name="thermal expansion"                                                         unit="degree_C-1" grid_ref="grid_T_3D" />
+         <field id="beta"         long_name="haline contraction"                                                        unit="1e3"    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" />
+
+         <!-- Energy - horizontal divergence -->
+         <field id="eken"         long_name="kinetic energy"          standard_name="specific_kinetic_energy_of_sea_water"   unit="m2/s2"  grid_ref="grid_T_3D" />
+         <field id="hdiv"         long_name="horizontal divergence"                                                          unit="s-1"    grid_ref="grid_T_3D" />
+
+         <!-- variables available with MLE -->
+         <field id="Lf_NHpf"      long_name="MLE: Lf = N H / f"   unit="m" />
+
+         <!-- next variables available with key_diahth -->
+         <field id="mlddzt"       long_name="Thermocline Depth (depth of max dT/dz)"         standard_name="depth_at_maximum_upward_derivative_of_sea_water_potential_temperature"             unit="m"    />
+         <field id="mldr10_3"     long_name="Mixed Layer Depth (dsigma = 0.03 wrt 10m)"      standard_name="ocean_mixed_layer_thickness_defined_by_sigma_theta"                                unit="m"    />
+         <field id="mldr0_1"      long_name="Mixed Layer Depth (dsigma = 0.01 wrt sfc)"      standard_name="ocean_mixed_layer_thickness_defined_by_sigma_theta"                                unit="m"    />
+         <field id="mldr0_3"      long_name="Mixed Layer Depth (dsigma = 0.03 wrt sfc)"      standard_name="ocean_mixed_layer_thickness_defined_by_sigma_theta"                                unit="m"    />
+         <field id="mld_dt02"     long_name="Mixed Layer Depth (|dT| = 0.2 wrt 10m)"         standard_name="ocean_mixed_layer_thickness_defined_by_temperature"                                unit="m"    />
+         <field id="topthdep"     long_name="Top of Thermocline Depth (dT = -0.2 wrt 10m)"   standard_name="ocean_mixed_layer_thickness_defined_by_temperature"                                unit="m"    />
+         <field id="pycndep"      long_name="Pycnocline Depth (dsigma[dT=-0.2] wrt 10m)"     standard_name="ocean_mixed_layer_thickness_defined_by_sigma_theta"                                unit="m"    />
+         <field id="BLT"          long_name="Barrier Layer Thickness"                                                                                                                          unit="m"    > topthdep - pycndep </field>
+         <field id="tinv"         long_name="Max of vertical invertion of temperature"                                                                                                         unit="degree_C"                      />
+         <field id="depti"        long_name="Depth of max. vert. inv. of temperature"                                                                                                          unit="m"                         />
+         <field id="20d"          long_name="Depth of 20C isotherm"                          standard_name="depth_of_isosurface_of_sea_water_potential_temperature"                            unit="m"      axis_ref="iax_20C" />
+         <field id="28d"          long_name="Depth of 28C isotherm"                          standard_name="depth_of_isosurface_of_sea_water_potential_temperature"                            unit="m"      axis_ref="iax_28C" />
+         <field id="hc300"        long_name="Heat content 0-300m"                            standard_name="integral_of_sea_water_potential_temperature_wrt_depth_expressed_as_heat_content"   unit="J/m2"                      />
+
+         <!-- variables available with key_diaar5 -->
+         <field id="botpres"      long_name="Sea Water Pressure at Sea Floor"   standard_name="sea_water_pressure_at_sea_floor"   unit="dbar" />
+         <field id="sshdyn"       long_name="dynamic sea surface height"     standard_name="dynamic_sea_surface_height_above_geoid"     unit="m" />
+         <field id="sshdyn2"      long_name="square of dynamic sea surface height"     standard_name="dynamic_sea_surface_height_above_geoid_squared"     unit="m2" > sshdyn * sshdyn </field>
+
+         <!-- variables available with key_vvl -->
+         <field id="tpt_dep"      long_name="T-point depth"                  standard_name="depth_below_geoid"   unit="m"   grid_ref="grid_T_3D" />
+         <field id="e3tdef"       long_name="T-cell thickness deformation"                                       unit="%"   grid_ref="grid_T_3D" />
+      </field_group>
+
+      <!-- Tides -->
+
+      <field_group id="Tides_T" grid_ref="grid_T_2D" operation="once" >
+         <!-- tidal composante -->
+         <field id="M2x"          long_name="M2 Elevation harmonic real part "                             unit="m"        />
+         <field id="M2y"          long_name="M2 Elevation harmonic imaginary part"                         unit="m"        />
+         <field id="S2x"          long_name="S2 Elevation harmonic real part "                             unit="m"        />
+         <field id="S2y"          long_name="S2 Elevation harmonic imaginary part"                         unit="m"        />
+         <field id="N2x"          long_name="N2 Elevation harmonic real part "                             unit="m"        />
+         <field id="N2y"          long_name="N2 Elevation harmonic imaginary part"                         unit="m"        />
+         <field id="K1x"          long_name="K1 Elevation harmonic real part "                             unit="m"        />
+         <field id="K1y"          long_name="K1 Elevation harmonic imaginary part"                         unit="m"        />
+         <field id="O1x"          long_name="O1 Elevation harmonic real part "                             unit="m"        />
+         <field id="O1y"          long_name="O1 Elevation harmonic imaginary part"                         unit="m"        />
+         <field id="Q1x"          long_name="Q1 Elevation harmonic real part "                             unit="m"        />
+         <field id="Q1y"          long_name="Q1 Elevation harmonic imaginary part"                         unit="m"        />
+         <field id="M4x"          long_name="M4 Elevation harmonic real part "                             unit="m"        />
+         <field id="M4y"          long_name="M4 Elevation harmonic imaginary part"                         unit="m"        />
+         <field id="K2x"          long_name="K2 Elevation harmonic real part "                             unit="m"        />
+         <field id="K2y"          long_name="K2 Elevation harmonic imaginary part"                         unit="m"        />
+         <field id="P1x"          long_name="P1 Elevation harmonic real part "                             unit="m"        />
+         <field id="P1y"          long_name="P1 Elevation harmonic imaginary part"                         unit="m"        />
+         <field id="Mfx"          long_name="Mf Elevation harmonic real part "                             unit="m"        />
+         <field id="Mfy"          long_name="Mf Elevation harmonic imaginary part"                         unit="m"        />
+         <field id="Mmx"          long_name="Mm Elevation harmonic real part "                             unit="m"        />
+         <field id="Mmy"          long_name="Mm Elevation harmonic imaginary part"                         unit="m"        />
+      </field_group>
+
+      <field_group id="Tides_U" grid_ref="grid_U_2D" operation="once" >
+         <field id="M2x_u"        long_name="M2 current barotrope along i-axis harmonic real part "        unit="m/s"      />
+         <field id="M2y_u"        long_name="M2 current barotrope along i-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="S2x_u"        long_name="S2 current barotrope along i-axis harmonic real part "        unit="m/s"      />
+         <field id="S2y_u"        long_name="S2 current barotrope along i-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="N2x_u"        long_name="N2 current barotrope along i-axis harmonic real part "        unit="m/s"      />
+         <field id="N2y_u"        long_name="N2 current barotrope along i-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="K1x_u"        long_name="K1 current barotrope along i-axis harmonic real part "        unit="m/s"      />
+         <field id="K1y_u"        long_name="K1 current barotrope along i-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="O1x_u"        long_name="O1 current barotrope along i-axis harmonic real part "        unit="m/s"      />
+         <field id="O1y_u"        long_name="O1 current barotrope along i-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="Q1x_u"        long_name="Q1 current barotrope along i-axis harmonic real part "        unit="m/s"      />
+         <field id="Q1y_u"        long_name="Q1 current barotrope along i-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="M4x_u"        long_name="M4 current barotrope along i-axis harmonic real part "        unit="m/s"      />
+         <field id="M4y_u"        long_name="M4 current barotrope along i-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="K2x_u"        long_name="K2 current barotrope along i-axis harmonic real part "        unit="m/s"      />
+         <field id="K2y_u"        long_name="K2 current barotrope along i-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="P1x_u"        long_name="P1 current barotrope along i-axis harmonic real part "        unit="m/s"      />
+         <field id="P1y_u"        long_name="P1 current barotrope along i-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="Mfx_u"        long_name="Mf current barotrope along i-axis harmonic real part "        unit="m/s"      />
+         <field id="Mfy_u"        long_name="Mf current barotrope along i-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="Mmx_u"        long_name="Mm current barotrope along i-axis harmonic real part "        unit="m/s"      />
+         <field id="Mmy_u"        long_name="Mm current barotrope along i-axis harmonic imaginary part "   unit="m/s"      />
+      </field_group>
+
+      <field_group id="Tides_V" grid_ref="grid_V_2D" operation="once" >
+         <field id="M2x_v"        long_name="M2 current barotrope along j-axis harmonic real part "        unit="m/s"      />
+         <field id="M2y_v"        long_name="M2 current barotrope along j-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="S2x_v"        long_name="S2 current barotrope along j-axis harmonic real part "        unit="m/s"      />
+         <field id="S2y_v"        long_name="S2 current barotrope along j-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="N2x_v"        long_name="N2 current barotrope along j-axis harmonic real part "        unit="m/s"      />
+         <field id="N2y_v"        long_name="N2 current barotrope along j-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="K1x_v"        long_name="K1 current barotrope along j-axis harmonic real part "        unit="m/s"      />
+         <field id="K1y_v"        long_name="K1 current barotrope along j-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="O1x_v"        long_name="O1 current barotrope along j-axis harmonic real part "        unit="m/s"      />
+         <field id="O1y_v"        long_name="O1 current barotrope along j-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="Q1x_v"        long_name="Q1 current barotrope along j-axis harmonic real part "        unit="m/s"      />
+         <field id="Q1y_v"        long_name="Q1 current barotrope along j-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="M4x_v"        long_name="M4 current barotrope along j-axis harmonic real part "        unit="m/s"      />
+         <field id="M4y_v"        long_name="M4 current barotrope along j-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="K2x_v"        long_name="K2 current barotrope along j-axis harmonic real part "        unit="m/s"      />
+         <field id="K2y_v"        long_name="K2 current barotrope along j-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="P1x_v"        long_name="P1 current barotrope along j-axis harmonic real part "        unit="m/s"      />
+         <field id="P1y_v"        long_name="P1 current barotrope along j-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="Mfx_v"        long_name="Mf current barotrope along j-axis harmonic real part "        unit="m/s"      />
+         <field id="Mfy_v"        long_name="Mf current barotrope along j-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="Mmx_v"        long_name="Mm current barotrope along j-axis harmonic real part "        unit="m/s"      />
+         <field id="Mmy_v"        long_name="Mm current barotrope along j-axis harmonic imaginary part "   unit="m/s"      />
+      </field_group>
+
+      <!-- SBC -->
+
+      <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="0.001/m2/s" />
+         <field id="fmmflx"       long_name="Water flux due to freezing/melting"                                                                                        unit="kg/m2/s"   />
+         <field id="snowpre"      long_name="Snow precipitation"                   standard_name="snowfall_flux"                                                        unit="kg/m2/s"   />
+         <field id="runoffs"      long_name="Water Flux into Sea Water From Rivers" standard_name="water_flux_into_sea_water_from_rivers"                                unit="kg/m2/s"   />
+         <field id="precip"       long_name="Total precipitation"                  standard_name="precipitation_flux"                                                   unit="kg/m2/s"   />
+
+         <field id="qt"           long_name="Net Downward Heat Flux"                standard_name="surface_downward_heat_flux_in_sea_water"                              unit="W/m2"                           />
+         <field id="qns"          long_name="non solar Downward Heat Flux"                                                                                               unit="W/m2"                           />
+         <field id="qsr"          long_name="Shortwave Radiation"                   standard_name="net_downward_shortwave_flux_at_sea_water_surface"                     unit="W/m2"                           />
+         <field id="qsr3d"        long_name="Shortwave Radiation 3D distribution"   standard_name="downwelling_shortwave_flux_in_sea_water"                              unit="W/m2"      grid_ref="grid_T_3D" />
+         <field id="qrp"          long_name="Surface Heat Flux: Damping"            standard_name="heat_flux_into_sea_water_due_to_newtonian_relaxation"                 unit="W/m2"                           />
+         <field id="erp"          long_name="Surface Water Flux: Damping"           standard_name="water_flux_out_of_sea_water_due_to_newtonian_relaxation"              unit="kg/m2/s"                        />
+         <field id="taum"         long_name="wind stress module"                    standard_name="magnitude_of_surface_downward_stress"                                 unit="N/m2"                           />
+         <field id="wspd"         long_name="wind speed module"                     standard_name="wind_speed"                                                           unit="m/s"                            />
+
+         <!-- * variable relative to atmospheric pressure forcing : available with ln_apr_dyn -->
+         <field id="ssh_ib"       long_name="Inverse barometer sea surface height"  standard_name="sea_surface_height_correction_due_to_air_pressure_at_low_frequency"   unit="m"        />
+
+         <!-- * variable related to ice shelf forcing * -->
+         <field id="berg_calve"   long_name="Iceberg calving"                               unit="kg/m2/s"  />
+         <field id="fwfisf"       long_name="Ice shelf melting"                             unit="kg/m2/s"  />
+         <field id="fwfisf3d"     long_name="Ice shelf melting"                             unit="kg/m2/s"  grid_ref="grid_T_3D" />
+         <field id="qlatisf"      long_name="Ice shelf latent heat flux"                    unit="W/m2"     />
+         <field id="qlatisf3d"    long_name="Ice shelf latent heat flux"                    unit="W/m2"     grid_ref="grid_T_3D" />
+         <field id="qhcisf"       long_name="Ice shelf heat content flux"                   unit="W/m2"     />
+         <field id="qhcisf3d"     long_name="Ice shelf heat content flux"                   unit="W/m2"     grid_ref="grid_T_3D" />
+         <field id="isfgammat"    long_name="transfert coefficient for isf (temperature)"   unit="m/s"      />
+         <field id="isfgammas"    long_name="transfert coefficient for isf (salinity)"      unit="m/s"      />
+         <field id="stbl"         long_name="salinity in the Losh tbl"                      unit="0.001"     />
+         <field id="ttbl"         long_name="temperature in the Losh tbl"                   unit="degree_C"     />
+
+         <!-- *_oce variables available with ln_blk_clio or ln_blk_core -->
+         <field id="qlw_oce"      long_name="Longwave Downward Heat Flux over open ocean"  standard_name="surface_net_downward_longwave_flux"   unit="W/m2"  />
+         <field id="qsb_oce"      long_name="Sensible Downward Heat Flux over open ocean"  standard_name="surface_downward_sensible_heat_flux"  unit="W/m2"  />
+         <field id="qla_oce"      long_name="Latent Downward Heat Flux over open ocean"    standard_name="surface_downward_latent_heat_flux"    unit="W/m2"  />
+         <field id="qemp_oce"     long_name="Downward Heat Flux from E-P over open ocean"                                                       unit="W/m2"  />
+         <field id="taum_oce"     long_name="wind stress module over open ocean"           standard_name="magnitude_of_surface_downward_stress" unit="N/m2"  />
+
+         <!-- available key_oasis3 -->
+         <field id="snow_ao_cea"  long_name="Snow over ice-free ocean (cell average)"   standard_name="snowfall_flux"                             unit="kg/m2/s"  />
+         <field id="snow_ai_cea"  long_name="Snow over sea-ice (cell average)"          standard_name="snowfall_flux"                             unit="kg/m2/s"  />
+         <field id="subl_ai_cea"  long_name="Sublimation over sea-ice (cell average)"   standard_name="surface_snow_and_ice_sublimation_flux"     unit="kg/m2/s"  />
+         <field id="icealb_cea"   long_name="Ice albedo (cell average)"                 standard_name="sea_ice_albedo"                            unit="1"        />
+         <field id="calving_cea"  long_name="Calving"                                   standard_name="water_flux_into_sea_water_from_icebergs"   unit="kg/m2/s"  />
+
+         <!-- available if key_oasis3 + conservative method -->
+         <field id="rain"          long_name="Liquid precipitation"                                     standard_name="rainfall_flux"                                                                 unit="kg/m2/s"  />
+         <field id="rain_ao_cea"   long_name="Liquid precipitation over ice-free ocean (cell average)"  standard_name="rainfall_flux"                                                                 unit="kg/m2/s"  />
+         <field id="evap_ao_cea"   long_name="Evaporation over ice-free ocean (cell average)"           standard_name="water_evaporation_flux"                                                        unit="kg/m2/s"  />
+         <field id="isnwmlt_cea"   long_name="Snow over Ice melting (cell average)"                     standard_name="surface_snow_melt_flux"                                                        unit="kg/m2/s"  />
+         <field id="fsal_virt_cea" long_name="Virtual salt flux due to ice formation (cell average)"    standard_name="virtual_salt_flux_into_sea_water_due_to_sea_ice_thermodynamics"                unit="kg/m2/s"  />
+         <field id="fsal_real_cea" long_name="Real salt flux due to ice formation (cell average)"       standard_name="downward_sea_ice_basal_salt_flux"                                              unit="kg/m2/s"  />
+         <field id="hflx_rain_cea" long_name="heat flux due to rainfall"                                standard_name="temperature_flux_due_to_rainfall_expressed_as_heat_flux_into_sea_water"        unit="W/m2"     />
+         <field id="hflx_prec_cea" long_name="heat flux due to precipitation"                           standard_name="temperature_flux_due_to_precipitation_expressed_as_heat_flux_into_sea_water"        unit="W/m2"     />
+         <field id="hflx_evap_cea" long_name="heat flux due to evaporation"                             standard_name="temperature_flux_due_to_evaporation_expressed_as_heat_flux_out_of_sea_water"   unit="W/m2"     />
+         <field id="hflx_snow_cea" long_name="heat flux due to snow falling over ice-free ocean"        standard_name="heat_flux_into_sea_water_due_to_snow_thermodynamics"                           unit="W/m2"     />
+         <field id="hflx_ice_cea"  long_name="heat flux due to ice thermodynamics"                      standard_name="heat_flux_into_sea_water_due_to_sea_ice_thermodynamics"                        unit="W/m2"     />
+         <field id="hflx_rnf_cea"  long_name="heat flux due to runoffs"                                 standard_name="temperature_flux_due_to_runoff_expressed_as_heat_flux_into_sea_water"          unit="W/m2"     />
+         <field id="hflx_cal_cea"  long_name="heat flux due to calving"                                 standard_name="heat_flux_into_sea_water_due_to_iceberg_thermodynamics"                        unit="W/m2"     />
+         <field id="bicemel_cea"   long_name="Rate of Melt at Sea Ice Base (cell average)"              standard_name="tendency_of_sea_ice_amount_due_to_basal_melting"                               unit="kg/m2/s"  />
+         <field id="licepro_cea"   long_name="Lateral Sea Ice Growth Rate (cell average)"               standard_name="tendency_of_sea_ice_amount_due_to_lateral_growth_of_ice_floes"                 unit="kg/m2/s"  />
+         <field id="snowmel_cea"   long_name="Snow Melt Rate (cell average)"                            standard_name="surface_snow_melt_flux"                                                        unit="kg/m2/s"  />
+         <field id="sntoice_cea"   long_name="Snow-Ice Formation Rate (cell average)"                   standard_name="tendency_of_sea_ice_amount_due_to_snow_conversion"                             unit="kg/m2/s"  />
+         <field id="ticemel_cea"   long_name="Rate of Melt at Upper Surface of Sea Ice (cell average)"  standard_name="tendency_of_sea_ice_amount_due_to_surface_melting"                             unit="kg/m2/s"  />
+
+         <!-- ice fields -->
+         <field id="ice_cover"    long_name="Ice fraction"                                                 standard_name="sea_ice_area_fraction"                              unit="1"            />
+
+         <field id="qsr_ai_cea"   long_name="Air-Ice downward solar heat flux (cell average)"              standard_name="surface_downwelling_shortwave_flux_in_air"          unit="W/m2"         />
+         <field id="qns_ai_cea"   long_name="Air-Ice downward non-solar heat flux (cell average)"                                                                             unit="W/m2"         />
+         <field id="qla_ai_cea"   long_name="Air-Ice downward Latent heat flux (cell average)"             standard_name="surface_downward_latent_heat_flux"                  unit="W/m2"         />
+
+         <field id="qsr_io_cea"   long_name="Ice-Oce downward solar heat flux (cell average)"              standard_name="net_downward_shortwave_flux_at_sea_water_surface"   unit="W/m2"         />
+         <field id="qns_io_cea"   long_name="Ice-Oce downward non-solar heat flux (cell average)"                                                                             unit="W/m2"         />
+
+         <field id="snowthic_cea" long_name="Snow thickness (cell average)"                                standard_name="surface_snow_thickness"                             unit="m"            />
+         <field id="icethic_cea"  long_name="Ice thickness (cell average)"                                 standard_name="sea_ice_thickness"                                  unit="m"            />
+         <field id="iceprod_cea"  long_name="Ice production (cell average)"                                                                                                   unit="m/s"          />
+         <field id="iiceconc"     long_name="Ice concentration"                                            standard_name="sea_ice_area_fraction"                              unit="1"            />
+
+         <field id="ice_pres"     long_name="Ice presence"                                                                                                                    unit=""             />
+         <field id="ist_cea"      long_name="Ice surface temperature (cell average)"                       standard_name="surface_temperature"                                unit="degree_C"         />
+         <field id="ist_ipa"      long_name="Ice surface temperature (ice presence average)"               standard_name="surface_temperature"                                unit="degree_C"         />
+         <field id="uice_ipa"     long_name="Ice velocity along i-axis at I-point (ice presence average)"  standard_name="sea_ice_x_velocity"                                 unit="m/s"          />
+         <field id="vice_ipa"     long_name="Ice velocity along j-axis at I-point (ice presence average)"  standard_name="sea_ice_y_velocity"                                 unit="m/s"          />
+
+         <field id="utau_ice"     long_name="Wind stress along i-axis over the ice at i-point"             standard_name="surface_downward_x_stress"                          unit="N/m2"         />
+         <field id="vtau_ice"     long_name="Wind stress along j-axis over the ice at i-point"             standard_name="surface_downward_y_stress"                          unit="N/m2"         />
+
+         <field id="u_imasstr"    long_name="Sea-ice mass transport along i-axis"                          standard_name="sea_ice_x_transport"                                unit="kg/s"         />
+         <field id="v_imasstr"    long_name="Sea-ice mass transport along j-axis"                          standard_name="sea_ice_y_transport"                                unit="kg/s"         />
+         <field id="emp_x_sst"    long_name="Concentration/Dilution term on SST"                                                                                              unit="kg*degree_C/m2/s" />
+         <field id="emp_x_sss"    long_name="Concentration/Dilution term on SSS"                                                                                              unit="kg*0.001/m2/s" />
+
+         <field id="iceconc"      long_name="ice concentration"                                            standard_name="sea_ice_area_fraction"                              unit="%"            />
+         <field id="isst"         long_name="sea surface temperature"                                      standard_name="sea_surface_temperature"                            unit="degree_C"         />
+         <field id="isss"         long_name="sea surface salinity"                                         standard_name="sea_surface_salinity"                               unit="0.001"         />
+         <field id="qt_oce"       long_name="total flux at ocean surface"                                  standard_name="surface_downward_heat_flux_in_sea_water"            unit="W/m2"         />
+         <field id="qsr_oce"      long_name="solar heat flux at ocean surface"                             standard_name="net_downward_shortwave_flux_at_sea_water_surface"   unit="W/m2"         />
+         <field id="qns_oce"      long_name="non-solar heat flux at ocean surface"                                                                                            unit="W/m2"         />
+         <field id="qt_ice"       long_name="total heat flux at ice surface: sum over categories"          standard_name="surface_downward_heat_flux_in_air"                  unit="W/m2"         />
+         <field id="qsr_ice"      long_name="solar heat flux at ice surface: sum over categories"          standard_name="surface_downwelling_shortwave_flux_in_air"          unit="W/m2"         />
+         <field id="qns_ice"      long_name="non-solar heat flux at ice surface: sum over categories"                                                                         unit="W/m2"         />
+         <field id="qtr_ice"      long_name="solar heat flux transmitted through ice: sum over categories"                                                                    unit="W/m2"         />
+         <field id="qemp_ice"     long_name="Downward Heat Flux from E-P over ice"                                                                                            unit="W/m2"         />
+         <field id="micesalt"     long_name="Mean ice salinity"                                                                                                               unit="0.001"         />
+         <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" />
+         <field id="iceconc_cat"  long_name="Ice concentration for categories"                             unit="%"      axis_ref="ncatice" />
+         <field id="icethic_cat"  long_name="Ice thickness for categories"                                 unit="m"      axis_ref="ncatice" />
+         <field id="snowthic_cat" long_name="Snow thicknessi for categories"                               unit="m"      axis_ref="ncatice" />
+         <field id="salinity_cat" long_name="Sea-Ice Bulk salinity for categories"                         unit="g/kg"   axis_ref="ncatice" />
+         <field id="brinevol_cat" long_name="Brine volume for categories"                                  unit="%"      axis_ref="ncatice" />
+         <field id="icetemp_cat"  long_name="Ice temperature for categories"                               unit="degree_C"   axis_ref="ncatice" />
+         <field id="snwtemp_cat"  long_name="Snow temperature for categories"                              unit="degree_C"   axis_ref="ncatice" />
+
+         <field id="micet"        long_name="Mean ice temperature"                                         unit="degree_C"     />
+         <field id="icehc"        long_name="ice total heat content"                                       unit="10^9J"    />
+         <field id="isnowhc"      long_name="snow total heat content"                                      unit="10^9J"    />
+         <field id="icest"        long_name="ice surface temperature"                                      unit="degree_C"     />
+         <field id="ibrinv"       long_name="brine volume"                                                 unit="%"        />
+         <field id="icecolf"      long_name="frazil ice collection thickness"                              unit="m"        />
+         <field id="icestr"       long_name="ice strength"                                                 unit="N/m"      />
+         <field id="icevel"       long_name="ice velocity"                                                 unit="m/s"      />
+         <field id="idive"        long_name="divergence"                                                   unit="1e-8s-1"  />
+         <field id="ishear"       long_name="shear"                                                        unit="1e-8s-1"  />
+         <field id="icevolu"      long_name="ice volume"                                                   unit="m"        />
+         <field id="snowvol"      long_name="snow volume"                                                  unit="m"        />
+
+         <field id="icetrp"       long_name="ice volume transport"                                         unit="m/day"          />
+         <field id="snwtrp"       long_name="snw volume transport"                                         unit="m/day"          />
+         <field id="saltrp"       long_name="salt content transport"                                       unit="0.001*kg/m2/day" />
+         <field id="deitrp"       long_name="advected ice enthalpy"                                        unit="W/m2"           />
+         <field id="destrp"       long_name="advected snw enthalpy"                                        unit="W/m2"           />
+
+         <field id="sfxbri"       long_name="brine salt flux"                                              unit="0.001*kg/m2/day" />
+         <field id="sfxdyn"       long_name="salt flux from ridging rafting"                               unit="0.001*kg/m2/day" />
+         <field id="sfxres"       long_name="salt flux from lipupdate (resultant)"                         unit="0.001*kg/m2/day" />
+         <field id="sfxbog"       long_name="salt flux from bot growth"                                    unit="0.001*kg/m2/day" />
+         <field id="sfxbom"       long_name="salt flux from bot melt"                                      unit="0.001*kg/m2/day" />
+         <field id="sfxsum"       long_name="salt flux from surf melt"                                     unit="0.001*kg/m2/day" />
+         <field id="sfxsni"       long_name="salt flux from snow-ice formation"                            unit="0.001*kg/m2/day" />
+         <field id="sfxopw"       long_name="salt flux from open water ice formation"                      unit="0.001*kg/m2/day" />
+         <field id="sfxsub"       long_name="salt flux from sublimation"                                   unit="0.001*kg/m2/day" />
+         <field id="sfx"          long_name="salt flux total"                                              unit="0.001*kg/m2/day" />
+
+         <field id="vfxbog"       long_name="daily bottom thermo ice prod."                                unit="m/day"   />
+         <field id="vfxdyn"       long_name="daily  dynamic ice prod."                                     unit="m/day"   />
+         <field id="vfxopw"       long_name="daily lateral thermo ice prod."                               unit="m/day"   />
+         <field id="vfxsni"       long_name="daily snowice ice prod."                                      unit="m/day"   />
+         <field id="vfxsum"       long_name="surface melt"                                                 unit="m/day"   />
+         <field id="vfxbom"       long_name="bottom melt"                                                  unit="m/day"   />
+         <field id="vfxres"       long_name="daily resultant ice prod./melting from limupdate"             unit="m/day"   />
+         <field id="vfxice"       long_name="ice melt/growth"                                              unit="m/day"   />
+         <field id="vfxsnw"       long_name="snw melt/growth"                                              unit="m/day"   />
+         <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"   />
+         <field id="afxdyn"       long_name="area tendency (dynamics)"                                     unit="day-1"   />
+         <field id="afxthd"       long_name="area tendency (thermo)"                                       unit="day-1"   />
+
+         <field id="hfxsum"       long_name="heat fluxes causing surface ice melt"                         unit="W/m2"  />
+         <field id="hfxbom"       long_name="heat fluxes causing bottom ice melt"                          unit="W/m2"  />
+         <field id="hfxbog"       long_name="heat fluxes causing bottom ice growth"                        unit="W/m2"  />
+         <field id="hfxdif"       long_name="heat fluxes causing ice temperature change"                   unit="W/m2"  />
+         <field id="hfxopw"       long_name="heat fluxes causing open water ice formation"                 unit="W/m2"  />
+         <field id="hfxsnw"       long_name="heat fluxes causing snow melt"                                unit="W/m2"  />
+         <field id="hfxerr"       long_name="heat fluxes error after heat diffusion"                       unit="W/m2"  />
+         <field id="hfxerr_rem"   long_name="heat fluxes error after remapping"                            unit="W/m2"  />
+         <field id="hfxout"       long_name="total heat fluxes received by the ocean"                      unit="W/m2"  />
+         <field id="hfxin"        long_name="total heat fluxes at the ice/ocean surface"                   unit="W/m2"  />
+
+         <!-- heat flux associated with mass exchange -->
+         <field id="hfxthd"       long_name="heat fluxes from ice-ocean mass exchange during thermo"       unit="W/m2"  />
+         <field id="hfxdyn"       long_name="heat fluxes from ice-ocean mass exchange during dynamic"      unit="W/m2"  />
+         <field id="hfxres"       long_name="heat fluxes from ice-ocean mass exchange during resultant"    unit="W/m2"  />
+         <field id="hfxsub"       long_name="heat fluxes from ice-atm. mass exchange during sublimation"   unit="W/m2"  />
+         <field id="hfxspr"       long_name="heat fluxes from ice-atm. mass exchange during snow precip"   unit="W/m2"  />
+
+         <!-- diags -->
+         <field id="hfxdhc"       long_name="Heat content variation in snow and ice"                       unit="W/m2" />
+         <field id="hfxtur"       long_name="turbulent heat flux at the ice base"                          unit="W/m2" />
+         <!-- sbcssm variables -->
+         <field id="sst_m"    unit="degree_C" />
+         <field id="sss_m"    unit="psu"  />
+         <field id="ssu_m"    unit="m/s"  />
+         <field id="ssv_m"    unit="m/s"  />
+         <field id="ssh_m"    unit="m"    />
+         <field id="e3t_m"    unit="m"    />
+         <field id="frq_m"    unit="-"    />
+
+      </field_group>
+
+      <!-- U grid -->
+
+      <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="Surface Downward X Stress"                               standard_name="surface_downward_x_stress"   unit="N/m2"                            />
+         <field id="uoce"         long_name="Sea Water X Velocity"                             standard_name="sea_water_x_velocity"        unit="m/s"        grid_ref="grid_U_3D" />
+         <field id="uoce_e3u"     long_name="ocean current along i-axis * e3u"                                                                   unit="m2/s"       grid_ref="grid_U_3D"  > uoce * e3u </field>
+         <field id="uoce2_e3u"    long_name="ocean current along i-axis squared * e3u"                                                           unit="m3/s2"      grid_ref="grid_U_3D"  > uoce * uoce * e3u </field>
+         <field id="ssu"          long_name="ocean surface current along i-axis"                                                                 unit="m/s"                             />
+         <field id="sbu"          long_name="ocean bottom current along i-axis"                                                                  unit="m/s"                             />
+         <field id="ubar"         long_name="ocean barotropic current along i-axis"                                                              unit="m/s"                             />
+         <field id="uocetr_eff"   long_name="Effective ocean transport along i-axis"                 standard_name="ocean_volume_x_transport"    unit="m3/s"       grid_ref="grid_U_3D" />
+         <field id="uocet"        long_name="ocean transport along i-axis times temperature (CRS)"                                               unit="degree_C*m/s"   grid_ref="grid_U_3D" />
+         <field id="uoces"        long_name="ocean transport along i-axis times salinity (CRS)"                                                  unit="0.001*m/s"   grid_ref="grid_U_3D" />
+
+         <!-- variables available with MLE -->
+         <field id="psiu_mle"     long_name="MLE streamfunction along i-axis"   unit="m3/s"   grid_ref="grid_U_3D" />
+
+         <!-- uoce_eiv: available with key_traldf_eiv and key_diaeiv -->
+         <field id="uoce_eiv"      long_name="EIV ocean current along i-axis"   standard_name="bolus_sea_water_x_velocity"   unit="m/s"   grid_ref="grid_U_3D" />
+         <field id="ueiv_masstr"   long_name="EIV Ocean Mass X Transport"    standard_name="bolus_ocean_mass_x_transport"                          unit="kg/s"        grid_ref="grid_U_3D" />
+         <field id="ueiv_heattr3d" long_name="ocean bolus heat transport along i-axis"    standard_name="ocean_heat_x_transport_due_to_bolus_advection"   unit="W"    grid_ref="grid_U_3D" />
+         <field id="ueiv_salttr3d" long_name="ocean bolus salt transport along i-axis"    standard_name="ocean_salt_x_transport_due_to_bolus_advection"   unit="kg"   grid_ref="grid_U_3D" />
+         <field id="ueiv_masstr"  long_name="EIV Ocean Mass X Transport"    standard_name="bolus_ocean_mass_x_transport"                          unit="kg/s"        grid_ref="grid_U_3D" />
+
+         <!-- uoce_eiv: available with key_trabbl -->
+         <field id="uoce_bbl"     long_name="BBL ocean current along i-axis"    unit="m/s"  />
+         <field id="ahu_bbl"      long_name="BBL diffusive flux along i-axis"   unit="m3/s" />
+
+         <!-- variable for ice shelves -->
+         <field id="utbl"         long_name="zonal current in the Losh tbl"     unit="m/s" />
+
+         <!-- variables available with key_diaar5 -->
+         <field id="u_masstr"     long_name="Ocean Mass X Transport"    standard_name="ocean_mass_x_transport"                          unit="kg/s"        grid_ref="grid_U_3D" />
+         <field id="u_masstr_vint" long_name="vertical integral of ocean eulerian mass transport along i-axis"    standard_name="vertical_integral_of_ocean_mass_x_transport"  unit="kg/s" />
+         <field id="u_heattr"     long_name="ocean eulerian heat transport along i-axis"    standard_name="ocean_heat_x_transport"                          unit="W"                                />
+         <field id="uadv_heattr"  long_name="ocean advective heat transport along i-axis"    standard_name="advectice_ocean_heat_x_transport"                          unit="W"                                />
+         <field id="u_salttr"     long_name="ocean eulerian salt transport along i-axis"    standard_name="ocean_salt_x_transport"                          unit="0.001*kg/s"                        />
+         <field id="ueiv_heattr"  long_name="ocean bolus heat transport along i-axis"       standard_name="ocean_heat_x_transport_due_to_bolus_advection"   unit="W"                                />
+         <field id="ueiv_salttr"  long_name="ocean bolus salt transport along i-axis"       standard_name="ocean_salt_x_transport_due_to_bolus_advection"   unit="W"                                />
+         <field id="udiff_heattr" long_name="ocean diffusion heat transport along i-axis"   standard_name="ocean_heat_x_transport_due_to_diffusion"         unit="W"                                />
+      </field_group>
+
+      <!-- V grid -->
+
+      <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="Surface Downward Y Stress"                               standard_name="surface_downward_y_stress"   unit="N/m2"                            />
+         <field id="voce"         long_name="Sea Water Y Velocity"                             standard_name="sea_water_y_velocity"        unit="m/s"        grid_ref="grid_V_3D" />
+         <field id="voce_e3v"     long_name="ocean current along j-axis * e3v"                                                                   unit="m2/s"       grid_ref="grid_V_3D"  > voce * e3v </field>
+         <field id="voce2_e3v"    long_name="ocean current along j-axis squared * e3v"                                                           unit="m3/s2"      grid_ref="grid_V_3D"  > voce * voce * e3v </field>
+         <field id="ssv"          long_name="ocean surface current along j-axis"                                                                 unit="m/s"                             />
+         <field id="sbv"          long_name="ocean bottom current along j-axis"                                                                  unit="m/s"                             />
+         <field id="vbar"         long_name="ocean barotropic current along j-axis"                                                              unit="m/s"                             />
+         <field id="vocetr_eff"   long_name="Effective ocean transport along j-axis"                 standard_name="ocean_volume_y_transport"    unit="m3/s"       grid_ref="grid_V_3D" />
+         <field id="vocet"        long_name="ocean transport along j-axis times temperature (CRS)"                                               unit="degree_C*m/s"   grid_ref="grid_V_3D" />
+         <field id="voces"        long_name="ocean transport along j-axis times salinity (CRS)"                                                  unit="0.001*m/s"   grid_ref="grid_V_3D" />
+
+         <!-- variables available with MLE -->
+         <field id="psiv_mle"     long_name="MLE streamfunction along j-axis"   unit="m3/s"   grid_ref="grid_V_3D" />
+
+         <!-- voce_eiv: available with key_traldf_eiv and key_diaeiv -->
+         <field id="voce_eiv"     long_name="EIV ocean current along j-axis"   standard_name="bolus_sea_water_y_velocity"   unit="m/s"   grid_ref="grid_V_3D" />
+         <field id="veiv_masstr"   long_name="EIV Ocean Mass Y Transport"    standard_name="bolus_ocean_mass_y_transport"                          unit="kg/s"        grid_ref="grid_V_3D" />
+         <field id="veiv_heattr3d" long_name="ocean bolus heat transport along j-axis"    standard_name="ocean_heat_y_transport_due_to_bolus_advection"   unit="W"    grid_ref="grid_V_3D" />
+         <field id="veiv_salttr3d" long_name="ocean bolus salt transport along j-axis"    standard_name="ocean_salt_y_transport_due_to_bolus_advection"   unit="kg"   grid_ref="grid_U_3D" />
+
+         <!-- voce_eiv: available with key_trabbl -->
+         <field id="voce_bbl"     long_name="BBL ocean current along j-axis"    unit="m/s"  />
+         <field id="ahv_bbl"      long_name="BBL diffusive flux along j-axis"   unit="m3/s" />
+
+         <!-- variable for ice shelves -->
+         <field id="vtbl"         long_name="meridional current in the Losh tbl"   unit="m/s" />
+
+         <!-- variables available with key_diaar5 -->
+         <field id="v_masstr"     long_name="Ocean Mass Y Transport"    standard_name="ocean_mass_y_transport"                          unit="kg/s"        grid_ref="grid_V_3D" />
+         <field id="v_heattr"     long_name="Ocean Heat X Transport"    standard_name="ocean_heat_y_transport"                          unit="W"                                />
+         <field id="vadv_heattr"  long_name="ocean advective heat transport along j-axis"    standard_name="advectice_ocean_heat_y_transport"                          unit="W"                                />
+         <field id="v_salttr"     long_name="ocean eulerian salt transport along i-axis"    standard_name="ocean_salt_y_transport"                          unit="0.001*kg/s"                        />
+         <field id="veiv_heattr"  long_name="ocean bolus heat transport along j-axis"       standard_name="ocean_heat_y_transport_due_to_bolus_advection"   unit="W"                                />
+         <field id="veiv_salttr"  long_name="ocean bolus salt transport along j-axis"       standard_name="ocean_salt_y_transport_due_to_bolus_advection"   unit="W"                                />
+         <field id="vdiff_heattr" long_name="ocean diffusion heat transport along j-axis"   standard_name="ocean_heat_y_transport_due_to_diffusion"         unit="W"                                />
+      </field_group>
+
+      <!-- W grid -->
+
+      <field_group id="grid_W" grid_ref="grid_W_3D">
+        <field id="e3w"          long_name="W-cell thickness"                     standard_name="cell_thickness"              unit="m"    />
+        <field id="woce"         long_name="ocean vertical velocity"              standard_name="upward_sea_water_velocity"   unit="m/s"  />
+        <field id="wocetr_eff"   long_name="effective ocean vertical transport"                                               unit="m3/s" />
+
+        <!-- woce_eiv: available with key_traldf_eiv and key_diaeiv -->
+        <field id="woce_eiv"     long_name="EIV ocean vertical velocity"   standard_name="bolus_upward_sea_water_velocity"   unit="m/s" />
+        <field id="weiv_masstr"  long_name="EIV Upward Ocean Mass Transport"  standard_name="bolus_upward_ocean_mass_transport"             unit="kg/s"   />
+        <field id="weiv_heattr3d" long_name="ocean bolus heat transport along k-axis"    standard_name="ocean_heat_z_transport_due_to_bolus_advection"   unit="W" />
+        <field id="weiv_salttr3d" long_name="ocean bolus salt transport along k-axis"    standard_name="ocean_salt_z_transport_due_to_bolus_advection"   unit="kg"   grid_ref="grid_U_3D" />
+
+        <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 -->
+        <field id="avt_evd"      long_name="convective enhancement to vertical diffusivity"   standard_name="ocean_vertical_tracer_diffusivity_due_to_convection"     unit="m2/s" />
+        <field id="avm_evd"      long_name="convective enhancement to vertical viscosity"     standard_name="ocean_vertical_momentum_diffusivity_due_to_convection"   unit="m2/s" />
+
+        <!-- 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="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 -->
+        <field id="w_masstr"     long_name="Upward Ocean Mass Transport"             standard_name="upward_ocean_mass_transport"             unit="kg/s"   />
+        <field id="w_masstr2"    long_name="square of vertical mass transport"   standard_name="square_of_upward_ocean_mass_transport"   unit="kg2/s2" />
+
+        <!-- aht2d and  aht2d_eiv: available with key_traldf_eiv and key_traldf_c2d -->
+        <field id="aht2d"        long_name="lateral eddy diffusivity"       standard_name="ocean_tracer_xy_laplacian_diffusivity"      unit="m2/s"   grid_ref="grid_W_2D" />
+        <field id="aht2d_eiv"    long_name="EIV lateral eddy diffusivity"   standard_name="ocean_tracer_bolus_laplacian_diffusivity"   unit="m2/s"   grid_ref="grid_W_2D" />
+        <!-- variables added for nn_etau revision testing -->
+        <field id="htau"         long_name="e-decay length scale of nn_etau TKE"       unit="m"        grid_ref="grid_W_2D" />
+        <field id="tke"          long_name="Turbulent Kinetic Energy"                  unit="m2/s2"    />
+        <field id="tke_niw"      long_name="Turbulent Kinetic Energy due to near-inertial wave breaking"  unit="m2/s2" />
+
+         <!-- Variable from eosbn2 -->
+         <field id="bn2"          long_name="Squared buoyancy frequency measuring ocean vertical stratification"        standard_name="square_of_brunt_vaisala_frequency_in_sea_water"   unit="1/s^2"  />
+      </field_group>
+
+      <!-- product fields -->
+      <field_group id="diaprod">
+        <field id="ut"           long_name="product_of_sea_water_x_velocity_and_potential_temperature"      unit="degree_C m/s"      grid_ref="grid_U_3D"   />
+        <field id="ut_e3u"       long_name="product_of_sea_water_x_velocity_and_potential_temperature * e3u"  unit="degree_C m2/s"   grid_ref="grid_U_3D" > ut * e3u </field >
+        <field id="us"           long_name="product_of_sea_water_x_velocity_and_salinity"                   unit="PSU m/s"       grid_ref="grid_U_3D"   />
+        <field id="us_e3u"       long_name="product_of_sea_water_x_velocity_and_salinity * e3u"             unit="PSU m2/s"      grid_ref="grid_U_3D" > us * e3u </field >
+        <field id="urhop"        long_name="product_of_sea_water_x_velocity_and_potential_density"          unit="(kg/m3).(m/s)" grid_ref="grid_U_3D"   />
+        <field id="urhop_e3u"    long_name="product_of_sea_water_x_velocity_and_potential_density * e3u"    unit="(kg/m3).(m2/s)"   grid_ref="grid_U_3D" > urhop * e3u </field >
+        <field id="vt"           long_name="product_of_sea_water_y_velocity_and_potential_temperature"      unit="degree_C m/s"      grid_ref="grid_V_3D"   />
+        <field id="vt_e3v"       long_name="product_of_sea_water_y_velocity_and_potential_temperature * e3v"  unit="degree_C m2/s"   grid_ref="grid_V_3D" > vt * e3v </field >
+        <field id="vs"           long_name="product_of_sea_water_y_velocity_and_salinity"                   unit="PSU m/s"       grid_ref="grid_V_3D"   />
+        <field id="vs_e3v"       long_name="product_of_sea_water_y_velocity_and_salinity * e3t"             unit="PSU m2/s"      grid_ref="grid_V_3D" > vs * e3v </field >
+        <field id="vrhop"        long_name="product_of_sea_water_y_velocity_and_potential_density"          unit="(kg/m3).(m/s)" grid_ref="grid_V_3D"   />
+        <field id="vrhop_e3v"    long_name="product_of_sea_water_y_velocity_and_potential_density * e3t"    unit="(kg/m3).(m2/s)"  grid_ref="grid_V_3D" > vrhop * e3v </field >
+        <field id="wt"           long_name="product_of_upward_sea_water_velocity_and_potential_temperature" unit="degree_C m/s"      grid_ref="grid_W_3D"   />
+        <field id="ws"           long_name="product_of_upward_sea_water_velocity_and_salinity"              unit="PSU m/s"       grid_ref="grid_W_3D"   />
+        <field id="wrhop"        long_name="product_of_upward_sea_water_velocity_and_potential_density"     unit="(kg/m3).(m/s)" grid_ref="grid_W_3D"   />
+      </field_group>
+
+      <!-- scalar variables available with key_diaar5 -->
+
+      <field_group id="scalar"  domain_ref="1point" >
+         <field id="voltot"     long_name="Sea Water Volume"                             standard_name="sea_water_volume"                               unit="m3"   />
+         <field id="sshtot"     long_name="global mean ssh"                              standard_name="global_average_sea_level_change"                unit="m"    />
+         <field id="sshsteric"  long_name="global mean ssh steric"                       standard_name="global_average_steric_sea_level_change"         unit="m"    />
+         <field id="sshthster"  long_name="Global Average Thermosteric Sea Level Change" standard_name="global_average_thermosteric_sea_level_change"   unit="m"    />
+         <field id="masstot"    long_name="global total mass"                            standard_name="sea_water_mass"                                 unit="kg"   />
+         <field id="temptot"    long_name="Global Average Sea Water Potential Temperature"      standard_name="sea_water_potential_temperature"         unit="degree_C" />
+         <field id="saltot"     long_name="Global Average Sea Water Salinity"                   standard_name="sea_water_salinity"                      unit="0.001" />
+         <field id="fram_trans" long_name="Sea Ice Mass Transport Through Fram Strait"   standard_name="sea_ice_transport_across_line"                  unit="kg/s" />
+
+         <!-- available with ln_diahsb -->
+         <field id="bgtemper"     long_name="drift in global mean temperature wrt timestep 1"                 standard_name="change_over_time_in_sea_water_potential_temperature"   unit="degree_C"     />
+         <field id="bgsaline"     long_name="drift in global mean salinity wrt timestep 1"                    standard_name="change_over_time_in_sea_water_practical_salinity"      unit="0.001"     />
+         <field id="bgheatco"     long_name="drift in global mean heat content wrt timestep 1"                                                                                      unit="10^9J"    />
+         <field id="bgsaltco"     long_name="drift in global mean salt content wrt timestep 1"                                                                                      unit="0.001*m3"  />
+         <field id="bgvolssh"     long_name="drift in global mean ssh volume wrt timestep 1"                                                                                        unit="km3"      />
+         <field id="bgvole3t"     long_name="drift in global mean volume variation (e3t) wrt timestep 1"                                                                            unit="km3"      />
+         <field id="bgvoltot"     long_name="drift in global mean volume wrt timestep 1"                                                                                            unit="km3"      />
+         <!-- NOTE: No matching iom_put call -->
+         <field id="bgsshtot"     long_name="drift in global mean ssh wrt timestep 1"                         standard_name="global_average_sea_level_change"                       unit="m"        />
+         <field id="bgfrcvol"     long_name="drift in global mean volume from forcing wrt timestep 1"                                                                               unit="km3"      />
+         <field id="bgfrctem"     long_name="drift in global mean heat content from forcing wrt timestep 1"                                                                         unit="10^9J"    />
+         <field id="bgfrcsal"     long_name="drift in global mean salt content from forcing wrt timestep 1"                                                                         unit="0.001*km3" />
+         <field id="bgmistem"     long_name="global mean temperature error due to free surface"                                                                                     unit="degree_C"     />
+         <field id="bgmissal"     long_name="global mean salinity error due to free surface"                                                                                        unit="0.001"     />
+      </field_group>
+
+      <!-- LIM3 scalar variables -->
+
+      <field_group id="SBC_scalar"  domain_ref="1point" >
+         <!-- available with ln_limdiaout -->
+         <field id="ibgvoltot"    long_name="global mean ice volume"                                 unit="km3"        />
+         <field id="sbgvoltot"    long_name="global mean snow volume"                                unit="km3"        />
+         <field id="ibgarea"      long_name="global mean ice area"                                   unit="km2"        />
+         <field id="ibgsaline"    long_name="global mean ice salinity"                               unit="0.001"       />
+         <field id="ibgtemper"    long_name="global mean ice temperature"                            unit="degree_C"       />
+         <field id="ibgheatco"    long_name="global mean ice heat content"                           unit="10^20J"     />
+         <field id="sbgheatco"    long_name="global mean snow heat content"                          unit="10^20J"     />
+         <field id="ibgsaltco"    long_name="global mean ice salt content"                           unit="0.001*km3"   />
+
+         <field id="ibgvfx"       long_name="global mean volume flux (emp)"                          unit="m/day"      />
+         <field id="ibgvfxbog"    long_name="global mean volume flux (bottom growth)"                unit="m/day"      />
+         <field id="ibgvfxopw"    long_name="global mean volume flux (open water growth)"            unit="m/day"      />
+         <field id="ibgvfxsni"    long_name="global mean volume flux (snow-ice growth)"              unit="m/day"      />
+         <field id="ibgvfxdyn"    long_name="global mean volume flux (dynamic growth)"               unit="m/day"      />
+         <field id="ibgvfxbom"    long_name="global mean volume flux (bottom melt)"                  unit="m/day"      />
+         <field id="ibgvfxsum"    long_name="global mean volume flux (surface melt)"                 unit="m/day"      />
+         <field id="ibgvfxres"    long_name="global mean volume flux (resultant)"                    unit="m/day"      />
+         <field id="ibgvfxspr"    long_name="global mean volume flux (snow precip)"                  unit="m/day"      />
+         <field id="ibgvfxsnw"    long_name="global mean volume flux (snow melt)"                    unit="m/day"      />
+         <field id="ibgvfxsub"    long_name="global mean volume flux (snow sublimation)"             unit="m/day"      />
+
+         <field id="ibgsfx"       long_name="global mean salt flux (total)"                          unit="0.001*m/day" />
+         <field id="ibgsfxbri"    long_name="global mean salt flux (brines)"                         unit="0.001*m/day" />
+         <field id="ibgsfxdyn"    long_name="global mean salt flux (dynamic)"                        unit="0.001*m/day" />
+         <field id="ibgsfxres"    long_name="global mean salt flux (resultant)"                      unit="0.001*m/day" />
+         <field id="ibgsfxbog"    long_name="global mean salt flux (thermo)"                         unit="0.001*m/day" />
+         <field id="ibgsfxopw"    long_name="global mean salt flux (thermo)"                         unit="0.001*m/day" />
+         <field id="ibgsfxsni"    long_name="global mean salt flux (thermo)"                         unit="0.001*m/day" />
+         <field id="ibgsfxbom"    long_name="global mean salt flux (thermo)"                         unit="0.001*m/day" />
+         <field id="ibgsfxsum"    long_name="global mean salt flux (thermo)"                         unit="0.001*m/day" />
+         <field id="ibgsfxsub"    long_name="global mean salt flux (thermo)"                         unit="0.001*m/day" />
+
+         <field id="ibghfxdhc"    long_name="Heat content variation in snow and ice"                 unit="W"          />
+         <field id="ibghfxspr"    long_name="Heat content of snow precip"                            unit="W"          />
+
+         <field id="ibghfxthd"    long_name="heat fluxes from ice-ocean exchange during thermo"      unit="W"          />
+         <field id="ibghfxsum"    long_name="heat fluxes causing surface ice melt"                   unit="W"          />
+         <field id="ibghfxbom"    long_name="heat fluxes causing bottom ice melt"                    unit="W"          />
+         <field id="ibghfxbog"    long_name="heat fluxes causing bottom ice growth"                  unit="W"          />
+         <field id="ibghfxdif"    long_name="heat fluxes causing ice temperature change"             unit="W"          />
+         <field id="ibghfxopw"    long_name="heat fluxes causing open water ice formation"           unit="W"          />
+         <field id="ibghfxdyn"    long_name="heat fluxes from ice-ocean exchange during dynamic"     unit="W"          />
+         <field id="ibghfxres"    long_name="heat fluxes from ice-ocean exchange during resultant"   unit="W"          />
+         <field id="ibghfxsub"    long_name="heat fluxes from sublimation"                           unit="W"          />
+         <field id="ibghfxsnw"    long_name="heat fluxes from snow-ocean exchange"                   unit="W"          />
+         <field id="ibghfxout"    long_name="non solar heat fluxes received by the ocean"            unit="W"          />
+         <field id="ibghfxin"     long_name="total heat fluxes at the ice surface"                   unit="W"          />
+
+         <field id="ibgfrcvol"    long_name="global mean forcing volume (emp)"                       unit="km3"        />
+         <field id="ibgfrcsfx"    long_name="global mean forcing salt   (sfx)"                       unit="0.001*km3"   />
+         <field id="ibgvolgrm"    long_name="global mean ice growth+melt volume"                     unit="km3"        />
+      </field_group>
+
+      <!-- variables available with key_float -->
+
+      <field_group id="floatvar" domain_ref="1point" axis_ref="nfloat" operation="instant" >
+        <field id="traj_lon"      long_name="floats longitude"                                                           unit="degrees_east"  />
+        <field id="traj_lat"      long_name="floats latitude"                                                            unit="degrees_north" />
+        <field id="traj_dep"      long_name="floats depth"                                                               unit="m"             />
+        <field id="traj_temp"     long_name="floats temperature"       standard_name="sea_water_potential_temperature"   unit="degree_C"          />
+        <field id="traj_salt"     long_name="floats salinity"          standard_name="sea_water_practical_salinity"      unit="0.001"          />
+        <field id="traj_dens"     long_name="floats in-situ density"   standard_name="sea_water_density"                 unit="kg/m3"         />
+        <field id="traj_group"    long_name="floats group"                                                               unit="1"             />
+      </field_group>
+
+      <!-- variables available with iceberg trajectories -->
+
+      <field_group id="icbvar" grid_ref="grid_T_2D"  >
+        <field id="berg_total_melt"    long_name="icb melt rate 2 of icebergs"                     unit="kg/m2/s"                    />
+        <field id="berg_total_heat_flux"  long_name="icb latent heat of melting of icebergs"          unit="kg/m2/s"                    />
+        <field id="berg_melt"          long_name="icb melt rate of icebergs"                       unit="kg/m2/s"                    />
+        <field id="berg_buoy_melt"     long_name="icb buoyancy component of iceberg melt rate"     unit="kg/m2/s"                    />
+        <field id="berg_eros_melt"     long_name="icb erosion component of iceberg melt rate"      unit="kg/m2/s"                    />
+        <field id="berg_conv_melt"     long_name="icb convective component of iceberg melt rate"   unit="kg/m2/s"                    />
+        <field id="berg_virtual_area"  long_name="icb virtual coverage by icebergs"                unit="m2"                         />
+        <field id="bits_src"           long_name="icb mass source of bergy bits"                   unit="kg/m2/s"                    />
+        <field id="bits_melt"          long_name="icb melt rate of bergy bits"                     unit="kg/m2/s"                    />
+        <field id="bits_mass"          long_name="icb bergy bit density field"                     unit="kg/m2"                      />
+        <field id="berg_mass"          long_name="icb iceberg density field"                       unit="kg/m2"                      />
+        <field id="calving"            long_name="icb calving mass input"                          unit="kg/s"                       />
+        <field id="berg_floating_melt" long_name="icb melt rate of icebergs + bits"                unit="kg/m2/s"                    />
+        <field id="berg_real_calving"  long_name="icb calving into iceberg class"                  unit="kg/s"     axis_ref="icbcla" />
+        <field id="berg_stored_ice"    long_name="icb accumulated ice mass by class"               unit="kg"       axis_ref="icbcla" />
+      </field_group>
+
+      <!-- Poleward transport : ptr -->
+      <field_group id="diaptr">
+        <field id="zomsfglo"          long_name="Meridional Stream-Function: Global"           unit="Sv"       grid_ref="gznl_W_3D" />
+        <field id="zomsfatl"          long_name="Meridional Stream-Function: Atlantic"         unit="Sv"       grid_ref="gznl_W_3D" />
+        <field id="zomsfpac"          long_name="Meridional Stream-Function: Pacific"          unit="Sv"       grid_ref="gznl_W_3D" />
+        <field id="zomsfind"          long_name="Meridional Stream-Function: Indian"           unit="Sv"       grid_ref="gznl_W_3D" />
+        <field id="zomsfipc"          long_name="Meridional Stream-Function: Pacific+Indian"   unit="Sv"       grid_ref="gznl_W_3D" />
+        <field id="zotemglo"          long_name="Zonal Mean Temperature : Global"              unit="degree_C"     grid_ref="gznl_T_3D" />
+        <field id="zotematl"          long_name="Zonal Mean Temperature : Atlantic"            unit="degree_C"     grid_ref="gznl_T_3D" />
+        <field id="zotempac"          long_name="Zonal Mean Temperature : Pacific"             unit="degree_C"     grid_ref="gznl_T_3D" />
+        <field id="zotemind"          long_name="Zonal Mean Temperature : Indian"              unit="degree_C"     grid_ref="gznl_T_3D" />
+        <field id="zotemipc"          long_name="Zonal Mean Temperature : Pacific+Indian"      unit="degree_C"     grid_ref="gznl_T_3D" />
+        <field id="zosalglo"          long_name="Zonal Mean Salinity : Global"                 unit="0.001"     grid_ref="gznl_T_3D" />
+        <field id="zosalatl"          long_name="Zonal Mean Salinity : Atlantic"               unit="0.001"     grid_ref="gznl_T_3D" />
+        <field id="zosalpac"          long_name="Zonal Mean Salinity : Pacific"                unit="0.001"     grid_ref="gznl_T_3D" />
+        <field id="zosalind"          long_name="Zonal Mean Salinity : Indian"                 unit="0.001"     grid_ref="gznl_T_3D" />
+        <field id="zosalipc"          long_name="Zonal Mean Salinity : Pacific+Indian"         unit="0.001"     grid_ref="gznl_T_3D" />
+        <field id="zosrfglo"          long_name="Zonal Mean Surface"                           unit="m2"       grid_ref="gznl_T_3D" />
+        <field id="zosrfatl"          long_name="Zonal Mean Surface : Atlantic"                unit="m2"       grid_ref="gznl_T_3D" />
+        <field id="zosrfpac"          long_name="Zonal Mean Surface : Pacific"                 unit="m2"       grid_ref="gznl_T_3D" />
+        <field id="zosrfind"          long_name="Zonal Mean Surface : Indian"                  unit="m2"       grid_ref="gznl_T_3D" />
+        <field id="zosrfipc"          long_name="Zonal Mean Surface : Pacific+Indian"          unit="m2"       grid_ref="gznl_T_3D" />
+        <field id="sophtadv"          long_name="Advective Heat Transport"                     unit="PW"       grid_ref="gznl_T_2D" />
+        <field id="sophtadv_atl"      long_name="Advective Heat Transport: Atlantic"           unit="PW"       grid_ref="gznl_T_2D" />
+        <field id="sophtadv_pac"      long_name="Advective Heat Transport: Pacific"            unit="PW"       grid_ref="gznl_T_2D" />
+        <field id="sophtadv_ind"      long_name="Advective Heat Transport: Indian"             unit="PW"       grid_ref="gznl_T_2D" />
+        <field id="sophtadv_ipc"      long_name="Advective Heat Transport: Pacific+Indian"     unit="PW"       grid_ref="gznl_T_2D" />
+        <field id="sophtldf"          long_name="Diffusive Heat Transport"                     unit="PW"       grid_ref="gznl_T_2D" />
+        <field id="sophtldf_atl"      long_name="Diffusive Heat Transport: Atlantic"           unit="PW"       grid_ref="gznl_T_2D" />
+        <field id="sophtldf_pac"      long_name="Diffusive Heat Transport: Pacific"            unit="PW"       grid_ref="gznl_T_2D" />
+        <field id="sophtldf_ind"      long_name="Diffusive Heat Transport: Indian"             unit="PW"       grid_ref="gznl_T_2D" />
+        <field id="sophtldf_ipc"      long_name="Diffusive Heat Transport: Pacific+Indian"     unit="PW"       grid_ref="gznl_T_2D" />
+        <field id="sophtove"          long_name="Overturning Heat Transport"                     unit="PW"       grid_ref="gznl_T_2D" />
+        <field id="sophtove_atl"      long_name="Overturning Heat Transport: Atlantic"           unit="PW"       grid_ref="gznl_T_2D" />
+        <field id="sophtove_pac"      long_name="Overturning Heat Transport: Pacific"            unit="PW"       grid_ref="gznl_T_2D" />
+        <field id="sophtove_ind"      long_name="Overturning Heat Transport: Indian"             unit="PW"       grid_ref="gznl_T_2D" />
+        <field id="sophtove_ipc"      long_name="Overturning Heat Transport: Pacific+Indian"     unit="PW"       grid_ref="gznl_T_2D" />
+        <field id="sophtbtr"          long_name="Barotropic Heat Transport"                     unit="PW"       grid_ref="gznl_T_2D" />
+        <field id="sophtbtr_atl"      long_name="Barotropic Heat Transport: Atlantic"           unit="PW"       grid_ref="gznl_T_2D" />
+        <field id="sophtbtr_pac"      long_name="Barotropic Heat Transport: Pacific"            unit="PW"       grid_ref="gznl_T_2D" />
+        <field id="sophtbtr_ind"      long_name="Barotropic Heat Transport: Indian"             unit="PW"       grid_ref="gznl_T_2D" />
+        <field id="sophtbtr_ipc"      long_name="Barotropic Heat Transport: Pacific+Indian"     unit="PW"       grid_ref="gznl_T_2D" />
+        <field id="sophteiv"          long_name="Heat Transport from mesoscale eddy oveection"                     unit="PW"       grid_ref="gznl_T_2D" />
+        <field id="sophteiv_atl"      long_name="Heat Transport from mesoscale eddy advection: Atlantic"           unit="PW"       grid_ref="gznl_T_2D" />
+        <field id="sophteiv_pac"      long_name="Heat Transport from mesoscale eddy advection: Pacific"            unit="PW"       grid_ref="gznl_T_2D" />
+        <field id="sophteiv_ind"      long_name="Heat Transport from mesoscale eddy advection: Indian"             unit="PW"       grid_ref="gznl_T_2D" />
+        <field id="sophteiv_ipc"      long_name="Heat Transport from mesoscale eddy advection: Pacific+Indian"     unit="PW"       grid_ref="gznl_T_2D" />
+       <field id="sopstadv"          long_name="Advective Salt Transport"                     unit="Giga g/s" grid_ref="gznl_T_2D" />
+        <field id="sopstadv_atl"      long_name="Advective Salt Transport: Atlantic"           unit="Giga g/s" grid_ref="gznl_T_2D" />
+        <field id="sopstadv_pac"      long_name="Advective Salt Transport: Pacific"            unit="Giga g/s" grid_ref="gznl_T_2D" />
+        <field id="sopstadv_ind"      long_name="Advective Salt Transport: Indian"             unit="Giga g/s" grid_ref="gznl_T_2D" />
+        <field id="sopstadv_ipc"      long_name="Advective Salt Transport: Pacific+Indian"     unit="Giga g/s" grid_ref="gznl_T_2D" />
+        <field id="sopstove"          long_name="Overturning Salt Transport"                     unit="Giga g/s" grid_ref="gznl_T_2D" />
+        <field id="sopstove_atl"      long_name="Overturning Salt Transport: Atlantic"           unit="Giga g/s" grid_ref="gznl_T_2D" />
+        <field id="sopstove_pac"      long_name="Overturning Salt Transport: Pacific"            unit="Giga g/s" grid_ref="gznl_T_2D" />
+        <field id="sopstove_ind"      long_name="Overturning Salt Transport: Indian"             unit="Giga g/s" grid_ref="gznl_T_2D" />
+        <field id="sopstove_ipc"      long_name="Overturning Salt Transport: Pacific+Indian"     unit="Giga g/s" grid_ref="gznl_T_2D" />
+        <field id="sopstbtr"          long_name="Barotropic Salt Transport"                     unit="Giga g/s" grid_ref="gznl_T_2D" />
+        <field id="sopstbtr_atl"      long_name="Barotropic Salt Transport: Atlantic"           unit="Giga g/s" grid_ref="gznl_T_2D" />
+        <field id="sopstbtr_pac"      long_name="Barotropic Salt Transport: Pacific"            unit="Giga g/s" grid_ref="gznl_T_2D" />
+        <field id="sopstbtr_ind"      long_name="Barotropic Salt Transport: Indian"             unit="Giga g/s" grid_ref="gznl_T_2D" />
+        <field id="sopstbtr_ipc"      long_name="Barotropic Salt Transport: Pacific+Indian"     unit="Giga g/s" grid_ref="gznl_T_2D" />
+        <field id="sopstldf"          long_name="Diffusive Salt Transport"                     unit="Giga g/s" grid_ref="gznl_T_2D" />
+        <field id="sopstldf_atl"      long_name="Diffusive Salt Transport: Atlantic"           unit="Giga g/s" grid_ref="gznl_T_2D" />
+        <field id="sopstldf_pac"      long_name="Diffusive Salt Transport: Pacific"            unit="Giga g/s" grid_ref="gznl_T_2D" />
+        <field id="sopstldf_ind"      long_name="Diffusive Salt Transport: Indian"             unit="Giga g/s" grid_ref="gznl_T_2D" />
+        <field id="sopstldf_ipc"      long_name="Diffusive Salt Transport: Pacific+Indian"     unit="Giga g/s" grid_ref="gznl_T_2D" />
+        <field id="sopsteiv"          long_name="Salt Transport from mesoscale eddy advection"                     unit="Giga g/s"       grid_ref="gznl_T_2D" />
+        <field id="sopsteiv_atl"      long_name="Salt Transport from mesoscale eddy advection: Atlantic"           unit="Giga g/s"       grid_ref="gznl_T_2D" />
+        <field id="sopsteiv_pac"      long_name="Salt Transport from mesoscale eddy advection: Pacific"            unit="Giga g/s"       grid_ref="gznl_T_2D" />
+        <field id="sopsteiv_ind"      long_name="Salt Transport from mesoscale eddy advection: Indian"             unit="Giga g/s"       grid_ref="gznl_T_2D" />
+        <field id="sopsteiv_ipc"      long_name="Salt Transport from mesoscale eddy advection: Pacific+Indian"     unit="Giga g/s"       grid_ref="gznl_T_2D" />
+        <field id="sopht_vt"          long_name="Heat Transport"                     unit="PW"       grid_ref="gznl_T_2D" />
+        <field id="sopht_vt_atl"      long_name="Heat Transport: Atlantic"           unit="PW"       grid_ref="gznl_T_2D" />
+        <field id="sopht_vt_ind"      long_name="Heat Transport: Indian"             unit="PW"       grid_ref="gznl_T_2D" />
+        <field id="sopht_vt_pac"      long_name="Heat Transport: Pacific"            unit="PW"       grid_ref="gznl_T_2D" />
+        <field id="sopht_vt_ipc"      long_name="Heat Transport: Indo-Pacific"       unit="PW"       grid_ref="gznl_T_2D" />
+        <field id="sopst_vs"          long_name="Salt Transport"                     unit="Giga g/s"       grid_ref="gznl_T_2D" />
+        <field id="sopst_vs_atl"      long_name="Salt Transport: Atlantic"           unit="Giga g/s"       grid_ref="gznl_T_2D" />
+        <field id="sopst_vs_ind"      long_name="Salt Transport: Indian"             unit="Giga g/s"       grid_ref="gznl_T_2D" />
+        <field id="sopst_vs_pac"      long_name="Salt Transport: Pacific"            unit="Giga g/s"       grid_ref="gznl_T_2D" />
+        <field id="sopst_vs_ipc"      long_name="Salt Transport: Indo-Pacific"       unit="Giga g/s"       grid_ref="gznl_T_2D" />
+        <field id="vsum" grid_ref="gznl_T_2D" unit="none" standard_name="none" />
+        <field id="tmean" grid_ref="gznl_T_2D" unit="none" standard_name="none" />
+        <field id="section_area" grid_ref="gznl_T_2D" unit="none" standard_name="none" />
+      </field_group>
+
+    <!-- 
+         ============================================================================================================
+                  Physical ocean model trend diagnostics : temperature, KE, PE, momentum
+============================================================================================================
+    -->
+
+    <field_group id="trendT" grid_ref="grid_T_3D">
+      <!-- variables available with ln_tra_trd -->
+      <field id="ttrd_xad"      long_name="temperature-trend: i-advection"                                                                                          unit="degC/s"                        />
+      <field id="strd_xad"      long_name="salinity   -trend: i-advection"                                                                                          unit="1e-3/s"                        />
+      <field id="ttrd_yad"      long_name="temperature-trend: j-advection"                                                                                          unit="degC/s"                        />
+      <field id="strd_yad"      long_name="salinity   -trend: j-advection"                                                                                          unit="1e-3/s"                        />
+      <field id="ttrd_zad"      long_name="temperature-trend: k-advection"                                                                                          unit="degC/s"                        />
+      <field id="strd_zad"      long_name="salinity   -trend: k-advection"                                                                                          unit="1e-3/s"                        />
+      <field id="ttrd_ad"       long_name="temperature-trend: advection"               standard_name="tendency_of_sea_water_temperature_due_to_advection"           unit="degC/s"                         > sqrt( ttrd_xad^2 + ttrd_yad^2 + ttrd_zad^2 ) </field>
+      <field id="strd_ad"       long_name="salinity   -trend: advection"               standard_name="tendency_of_sea_water_salinity_due_to_advection"              unit="1e-3/s"                         > sqrt( strd_xad^2 + strd_yad^2 + strd_zad^2 ) </field>
+      <field id="ttrd_totad"    long_name="temperature-trend: total advection"         standard_name="tendency_of_sea_water_salinity_due_to_advection"              unit="degC/s"                        />
+      <field id="strd_totad"    long_name="salinity   -trend: total advection"         standard_name="tendency_of_sea_water_salinity_due_to_advection"              unit="1e-3/s"                        />
+      <field id="ttrd_sad"      long_name="temperature-trend: surface adv. (no-vvl)"                                                                                unit="degC/s"   grid_ref="grid_T_2D" />
+      <field id="strd_sad"      long_name="salinity   -trend: surface adv. (no-vvl)"                                                                                unit="1e-3/s"   grid_ref="grid_T_2D" />
+      <field id="ttrd_ldf"      long_name="temperature-trend: lateral  diffusion"      standard_name="tendency_of_sea_water_temperature_due_to_horizontal_mixing"   unit="degC/s"                        />
+      <field id="strd_ldf"      long_name="salinity   -trend: lateral  diffusion"      standard_name="tendency_of_sea_water_salinity_due_to_horizontal_mixing"      unit="1e-3/s"                        />
+      <field id="ttrd_zdf"      long_name="temperature-trend: vertical diffusion"      standard_name="tendency_of_sea_water_temperature_due_to_vertical_mixing"     unit="degC/s"                        />
+      <field id="strd_zdf"      long_name="salinity   -trend: vertical diffusion"      standard_name="tendency_of_sea_water_salinity_due_to_vertical_mixing"        unit="1e-3/s"                        />
+      <field id="ttrd_evd"      long_name="temperature-trend: EVD convection"                                                                                       unit="degC/s"                        />
+      <field id="strd_evd"      long_name="salinity   -trend: EVD convection"                                                                                       unit="1e-3/s"                        />
+
+      <!-- ln_traldf_iso=T only (iso-neutral diffusion) -->
+      <field id="ttrd_iso_x"    long_name="temperature-trend: isopycnal diffusion x-component"                                                                      unit="degC/s"                        />
+      <field id="strd_iso_x"    long_name="salinity   -trend: isopycnal diffusion x-component"                                                                      unit="1e-3/s"                        />
+      <field id="ttrd_iso_y"    long_name="temperature-trend: isopycnal diffusion y-component"                                                                      unit="degC/s"                        />
+      <field id="strd_iso_y"    long_name="salinity   -trend: isopycnal diffusion y-component"                                                                      unit="1e-3/s"                        />
+      <field id="ttrd_iso_z1"   long_name="temperature-trend: isopycnal diffusion z-component part 1"                                                               unit="degC/s"                        />
+      <field id="strd_iso_z1"   long_name="salinity   -trend: isopycnal diffusion z-component part 1"                                                               unit="1e-3/s"                        />
+      <field id="ttrd_iso_z"    long_name="temperature-trend: isopycnal diffusion z-component"                 unit="degC/s" > ttrd_iso_z1 + ttrd_zdf - ttrd_zdfp </field>
+      <field id="strd_iso_z"    long_name="salinity   -trend: isopycnal diffusion z-component"                 unit="1e-3/s" > strd_iso_z1 + strd_zdf - strd_zdfp </field>
+      <field id="ttrd_iso"      long_name="temperature-trend: isopycnal diffusion"                             unit="degC/s" > ttrd_ldf + ttrd_zdf - ttrd_zdfp </field>
+      <field id="strd_iso"      long_name="salinity   -trend: isopycnal diffusion"                             unit="1e-3/s" > strd_ldf + strd_zdf - strd_zdfp </field>
+      <field id="ttrd_zdfp"     long_name="temperature-trend: pure vert. diffusion"   unit="degC/s" />
+      <field id="strd_zdfp"     long_name="salinity   -trend: pure vert. diffusion"   unit="1e-3/s" />
+
+      <!-- -->
+      <field id="ttrd_dmp"      long_name="temperature-trend: interior restoring"        unit="degree_C/s" />
+      <field id="strd_dmp"      long_name="salinity   -trend: interior restoring"        unit="0.001/s" />
+      <field id="ttrd_bbl"      long_name="temperature-trend: bottom boundary layer"     unit="degree_C/s" />
+      <field id="strd_bbl"      long_name="salinity   -trend: bottom boundary layer"     unit="0.001/s" />
+      <field id="ttrd_npc"      long_name="temperature-trend: non-penetrative conv."     unit="degree_C/s" />
+      <field id="strd_npc"      long_name="salinity   -trend: non-penetrative conv."     unit="0.001/s" />
+      <field id="ttrd_qns"      long_name="temperature-trend: non-solar flux + runoff"   unit="degC/s" grid_ref="grid_T_2D"/>
+      <field id="strd_cdt"      long_name="salinity   -trend: C/D term       + runoff"   unit="degC/s" grid_ref="grid_T_2D"/>
+      <field id="ttrd_qsr"      long_name="temperature-trend: solar penetr. heating"     unit="degree_C/s" />
+      <field id="ttrd_bbc"      long_name="temperature-trend: geothermal heating"        unit="degree_C/s" />
+      <field id="ttrd_atf"      long_name="temperature-trend: asselin time filter"       unit="degree_C/s" />
+      <field id="strd_atf"      long_name="salinity   -trend: asselin time filter"       unit="0.001/s" />
+      <field id="ttrd_tot"      long_name="temperature-trend: total model trend"         unit="degC/s" />
+      <field id="strd_tot"      long_name="salinity   -trend: total model trend"         unit="1e-3/s" />
+
+      <!-- Thickness weighted versions: -->
+      <field id="ttrd_xad_e3t"      unit="degC/s * m" >  ttrd_xad * e3t </field>
+      <field id="strd_xad_e3t"      unit="1e-3/s * m" >  strd_xad * e3t </field>
+      <field id="ttrd_yad_e3t"      unit="degC/s * m" >  ttrd_yad * e3t </field>
+      <field id="strd_yad_e3t"      unit="1e-3/s * m" >  strd_yad * e3t </field>
+      <field id="ttrd_zad_e3t"      unit="degC/s * m" >  ttrd_zad * e3t </field>
+      <field id="strd_zad_e3t"      unit="1e-3/s * m" >  strd_zad * e3t </field>
+      <field id="ttrd_ad_e3t"       unit="degC/s * m" >  ttrd_ad  * e3t </field>
+      <field id="strd_ad_e3t"       unit="1e-3/s * m" >  strd_ad  * e3t </field>
+      <field id="ttrd_totad_e3t"    unit="degC/s * m" >  ttrd_totad  * e3t </field>
+      <field id="strd_totad_e3t"    unit="1e-3/s * m" >  strd_totad  * e3t </field>
+      <field id="ttrd_ldf_e3t"      unit="degC/s * m" >  ttrd_ldf * e3t </field>
+      <field id="strd_ldf_e3t"      unit="1e-3/s * m" >  strd_ldf * e3t </field>
+      <field id="ttrd_zdf_e3t"      unit="degC/s * m" >  ttrd_zdf * e3t </field>
+      <field id="strd_zdf_e3t"      unit="1e-3/s * m" >  strd_zdf * e3t </field>
+      <field id="ttrd_evd_e3t"      unit="degC/s * m" >  ttrd_evd * e3t </field>
+      <field id="strd_evd_e3t"      unit="1e-3/s * m" >  strd_evd * e3t </field>
+
+      <!-- ln_traldf_iso=T only (iso-neutral diffusion) -->
+      <field id="ttrd_iso_x_e3t"    unit="degC/s * m"  >  ttrd_iso_x * e3t </field>
+      <field id="strd_iso_x_e3t"    unit="1e-3/s * m"  >  strd_iso_x * e3t </field>
+      <field id="ttrd_iso_y_e3t"    unit="degC/s * m"  >  ttrd_iso_y * e3t </field>
+      <field id="strd_iso_y_e3t"    unit="1e-3/s * m"  >  strd_iso_y * e3t </field>
+      <field id="ttrd_iso_z_e3t"    unit="degC/s * m"  >  ttrd_iso_z * e3t </field>
+      <field id="strd_iso_z_e3t"    unit="1e-3/s * m"  >  strd_iso_z * e3t </field>
+      <field id="ttrd_iso_e3t"      unit="degC/s * m"  >  ttrd_iso * e3t </field>
+      <field id="strd_iso_e3t"      unit="1e-3/s * m"  >  strd_iso * e3t </field>
+      <field id="ttrd_zdfp_e3t"     unit="degC/s * m"  >  ttrd_zdfp * e3t </field>
+      <field id="strd_zdfp_e3t"     unit="1e-3/s * m"  >  strd_zdfp * e3t </field>
+
+      <!-- -->
+      <field id="ttrd_dmp_e3t"      unit="degC/s * m"  >  ttrd_dmp * e3t </field>
+      <field id="strd_dmp_e3t"      unit="1e-3/s * m"  >  strd_dmp * e3t </field>
+      <field id="ttrd_bbl_e3t"      unit="degC/s * m"  >  ttrd_bbl * e3t </field>
+      <field id="strd_bbl_e3t"      unit="1e-3/s * m"  >  strd_bbl * e3t </field>
+      <field id="ttrd_npc_e3t"      unit="degC/s * m"  >  ttrd_npc * e3t </field>
+      <field id="strd_npc_e3t"      unit="1e-3/s * m"  >  strd_npc * e3t </field>
+      <field id="ttrd_qns_e3t"      unit="degC/s * m"  >  ttrd_qns * e3t_surf </field>
+      <field id="strd_cdt_e3t"      unit="degC/s * m"  >  strd_cdt * e3t_surf </field>
+      <field id="ttrd_qsr_e3t"      unit="degC/s * m"  >  ttrd_qsr * e3t </field>
+      <field id="ttrd_bbc_e3t"      unit="degC/s * m"  >  ttrd_bbc * e3t </field>
+      <field id="ttrd_atf_e3t"      unit="degC/s * m"  >  ttrd_atf * e3t </field>
+      <field id="strd_atf_e3t"      unit="1e-3/s * m"  >  strd_atf * e3t </field>
+      <field id="ttrd_tot_e3t"      unit="degC/s * m"  >  ttrd_tot * e3t </field>
+      <field id="strd_tot_e3t"      unit="1e-3/s * m"  >  strd_tot * e3t </field>
+
+      <!-- variables available with ln_KE_trd -->
+      <field id="ketrd_hpg"     long_name="ke-trend: hydrostatic pressure gradient"          unit="W/s^3"                        />
+      <field id="ketrd_spg"     long_name="ke-trend: surface     pressure gradient"          unit="W/s^3"                        />
+      <field id="ketrd_spgexp"  long_name="ke-trend: surface pressure gradient (explicit)"   unit="W/s^3"                        />
+      <field id="ketrd_spgflt"  long_name="ke-trend: surface pressure gradient (filter)"     unit="W/s^3"                        />
+      <field id="ssh_flt"       long_name="filtered contribution to ssh (dynspg_flt)"        unit="m"       grid_ref="grid_T_2D" />
+      <field id="w0"            long_name="surface vertical velocity"                        unit="m/s"     grid_ref="grid_T_2D" />
+      <field id="pw0_exp"       long_name="surface pressure flux due to ssh"                 unit="W/s^2"   grid_ref="grid_T_2D" />
+      <field id="pw0_flt"       long_name="surface pressure flux due to filtered ssh"        unit="W/s^2"   grid_ref="grid_T_2D" />
+      <field id="ketrd_keg"     long_name="ke-trend: KE gradient         or hor. adv."       unit="W/s^3"                        />
+      <field id="ketrd_rvo"     long_name="ke-trend: relative  vorticity or metric term"     unit="W/s^3"                        />
+      <field id="ketrd_pvo"     long_name="ke-trend: planetary vorticity"                    unit="W/s^3"                        />
+      <field id="ketrd_zad"     long_name="ke-trend: vertical  advection"                    unit="W/s^3"                        />
+      <field id="ketrd_udx"     long_name="ke-trend: U.dx[U]"                                unit="W/s^3"                        />
+      <field id="ketrd_ldf"     long_name="ke-trend: lateral   diffusion"                    unit="W/m^3"                        />
+      <field id="ketrd_ldf_e3t" field_ref="ketrd_ldf" long_name="ke-trend: lateral   diffusion * e3t" unit="W/m^2" >ketrd_ldf*e3t</field>
+      <field id="ketrd_ldf_vsum" field_ref="ketrd_ldf_e3t" long_name="ke-trend: lateral diffusion vertical integral" unit="W/m^2" grid_ref="vert_sum" />
+      <field id="ketrd_zdf"     long_name="ke-trend: vertical  diffusion"                    unit="W/s^3"                        />
+      <field id="ketrd_tau"     long_name="ke-trend: wind stress "                           unit="W/s^3"   grid_ref="grid_T_2D" />
+      <field id="ketrd_bfr"     long_name="ke-trend: bottom friction (explicit)"             unit="W/s^3"                        />
+      <field id="ketrd_bfri"    long_name="ke-trend: bottom friction (implicit)"             unit="W/s^3"                        />
+      <field id="ketrd_atf"     long_name="ke-trend: asselin time filter trend"              unit="W/s^3"                        />
+      <field id="ketrd_convP2K" long_name="ke-trend: conversion (potential to kinetic)"      unit="W/s^3"                        />
+      <field id="KE"            long_name="kinetic energy: u(n)*u(n+1)/2"                    unit="W/s^2"                        />
+      <field id="ketrd_eiv"     long_name="Kinetic energy trend from mesoscale eddy advection"   unit="W/s^2" grid_ref="grid_T_2D" />
+
+      <!-- variables available with ln_PE_trd -->
+      <field id="petrd_xad"     long_name="pe-trend: i-advection"                unit="W/m^3"                        />
+      <field id="petrd_yad"     long_name="pe-trend: j-advection"                unit="W/m^3"                        />
+      <field id="petrd_zad"     long_name="pe-trend: k-advection"                unit="W/m^3"                        />
+      <field id="petrd_sad"     long_name="pe-trend: surface adv. (no-vvl)"      unit="W/m^3"   grid_ref="grid_T_2D" />
+      <field id="petrd_ldf"     long_name="pe-trend: lateral  diffusion"         unit="W/m^3"                        />
+      <field id="petrd_zdf"     long_name="pe-trend: vertical diffusion"         unit="W/m^3"                        />
+      <field id="petrd_zdfp"    long_name="pe-trend: pure vert. diffusion"       unit="W/m^3"                        />
+      <field id="petrd_dmp"     long_name="pe-trend: interior restoring"         unit="W/m^3"                        />
+      <field id="petrd_bbl"     long_name="pe-trend: bottom boundary layer"      unit="W/m^3"                        />
+      <field id="petrd_npc"     long_name="pe-trend: non-penetrative conv."      unit="W/m^3"                        />
+      <field id="petrd_nsr"     long_name="pe-trend: surface forcing + runoff"   unit="W/m^3"                        />
+      <field id="petrd_qsr"     long_name="pe-trend: solar penetr. heating"      unit="W/m^3"                        />
+      <field id="petrd_bbc"     long_name="pe-trend: geothermal heating"         unit="W/m^3"                        />
+      <field id="petrd_atf"     long_name="pe-trend: asselin time filter"        unit="W/m^3"                        />
+      <field id="PEanom"        long_name="potential energy anomaly"             unit="1"                            />
+      <field id="alphaPE"       long_name="partial deriv. of PEanom wrt T"       unit="degree_C-1"                       />
+      <field id="betaPE"        long_name="partial deriv. of PEanom wrt S"       unit="1e3"                          />
+      <field id="petrd_zdfp_e3t"    unit="W/m^2" grid_ref="grid_T_3D"  > petrd_zdfp * e3t </field>
+      <field id="petrd_2d" field_ref="petrd_zdfp_e3t" grid_ref="vert_sum" />
+    </field_group>
+
+    <field_group id="trendU" grid_ref="grid_U_3D">
+     <!-- variables available with ln_dyn_trd -->
+     <field id="utrd_hpg"       long_name="i-trend: hydrostatic pressure gradient"          unit="m/s^2"                        />
+     <field id="utrd_spg"       long_name="i-trend: surface     pressure gradient"          unit="m/s^2"                        />
+     <field id="utrd_spgexp"    long_name="i-trend: surface pressure gradient (explicit)"   unit="m/s^2"                        />
+     <field id="utrd_spgflt"    long_name="i-trend: surface pressure gradient (filtered)"   unit="m/s^2"                        />
+     <field id="utrd_keg"       long_name="i-trend: KE gradient         or hor. adv."       unit="m/s^2"                        />
+     <field id="utrd_rvo"       long_name="i-trend: relative  vorticity or metric term"     unit="m/s^2"                        />
+     <field id="utrd_pvo"       long_name="i-trend: planetary vorticity"                    unit="m/s^2"                        />
+     <field id="utrd_zad"       long_name="i-trend: vertical  advection"                    unit="m/s^2"                        />
+     <field id="utrd_udx"       long_name="i-trend: U.dx[U]"                                unit="m/s^2"                        />
+     <field id="utrd_ldf"       long_name="i-trend: lateral   diffusion"                    unit="m/s^2"                        />
+     <field id="utrd_zdf"       long_name="i-trend: vertical  diffusion"                    unit="m/s^2"                        />
+     <field id="utrd_tau"       long_name="i-trend: wind stress "                           unit="m/s^2"   grid_ref="grid_U_2D" />
+     <field id="utrd_bfr"       long_name="i-trend: bottom friction (explicit)"             unit="m/s^2"                        />
+     <field id="utrd_bfri"      long_name="i-trend: bottom friction (implicit)"             unit="m/s^2"                        />
+     <field id="utrd_tot"       long_name="i-trend: total momentum trend before atf"        unit="m/s^2"                        />
+     <field id="utrd_atf"       long_name="i-trend: asselin time filter trend"              unit="m/s^2"                        />
+    </field_group>
+
+    <field_group id="trendV" grid_ref="grid_V_3D">
+     <!-- variables available with ln_dyn_trd -->
+     <field id="vtrd_hpg"       long_name="j-trend: hydrostatic pressure gradient"          unit="m/s^2"                        />
+     <field id="vtrd_spg"       long_name="j-trend: surface     pressure gradient"          unit="m/s^2"                        />
+     <field id="vtrd_spgexp"    long_name="j-trend: surface pressure gradient (explicit)"   unit="m/s^2"                        />
+     <field id="vtrd_spgflt"    long_name="j-trend: surface pressure gradient (filtered)"   unit="m/s^2"                        />
+     <field id="vtrd_keg"       long_name="j-trend: KE gradient         or hor. adv."       unit="m/s^2"                        />
+     <field id="vtrd_rvo"       long_name="j-trend: relative  vorticity or metric term"     unit="m/s^2"                        />
+     <field id="vtrd_pvo"       long_name="j-trend: planetary vorticity"                    unit="m/s^2"                        />
+     <field id="vtrd_zad"       long_name="j-trend: vertical  advection"                    unit="m/s^2"                        />
+     <field id="vtrd_vdy"       long_name="i-trend: V.dx[V]"                                unit="m/s^2"                        />
+     <field id="vtrd_ldf"       long_name="j-trend: lateral   diffusion"                    unit="m/s^2"                        />
+     <field id="vtrd_zdf"       long_name="j-trend: vertical  diffusion"                    unit="m/s^2"                        />
+     <field id="vtrd_tau"       long_name="j-trend: wind stress "                           unit="m/s^2"   grid_ref="grid_V_2D" />
+     <field id="vtrd_bfr"       long_name="j-trend: bottom friction (explicit)"             unit="m/s^2"                        />
+     <field id="vtrd_bfri"      long_name="j-trend: bottom friction (implicit)"             unit="m/s^2"                        />
+     <field id="vtrd_tot"       long_name="j-trend: total momentum trend before atf"        unit="m/s^2"                        />
+     <field id="vtrd_atf"       long_name="j-trend: asselin time filter trend"              unit="m/s^2"                        />
+    </field_group>
+
+
+    <!-- 
+============================================================================================================
+                                        Definitions for iodef_demo.xml
+============================================================================================================
+    -->
+
+    <field_group id="mooring" >
+      <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="uoce"         name="uo"       long_name="sea_water_x_velocity"                 />
+      <field field_ref="voce"         name="vo"       long_name="sea_water_y_velocity"                 />
+      <field field_ref="woce"         name="wo"       long_name="sea_water_z_velocity"                 />
+      <field field_ref="avt"          name="difvho"   long_name="ocean_vertical_heat_diffusivity"      />
+      <field field_ref="avm"          name="difvmo"   long_name="ocean_vertical_momentum_diffusivity"  />
+   
+      <field field_ref="sst"          name="tos"      long_name="sea_surface_temperature"                       />
+      <field field_ref="sst2"         name="tossq"    long_name="square_of_sea_surface_temperature"             />
+      <field field_ref="sstgrad"      name="tosgrad"  long_name="module_of_sea_surface_temperature_gradient"    />
+      <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="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="taum"                                                                                   />
+      <field field_ref="20d"                                                                                    />
+      <field field_ref="mldkz5"                                                                                 />
+      <field field_ref="mldr10_1"                                                                               />
+      <field field_ref="mldr10_3"                                                                               />
+      <field field_ref="mldr0_1"                                                                                />
+      <field field_ref="mldr0_3"                                                                                />
+      <field field_ref="mld_dt02"                                                                               />
+      <field field_ref="topthdep"                                                                               />
+      <field field_ref="pycndep"                                                                                />
+      <field field_ref="tinv"                                                                                   />
+      <field field_ref="depti"                                                                                  />
+      <field field_ref="BLT"          name="blt"      long_name="barrier_layer_thickness"                       />
+      <field field_ref="utau"         name="tauuo"    long_name="surface_downward_x_stress"                     />
+      <field field_ref="vtau"         name="tauvo"    long_name="surface_downward_y_stress"                     />
+    </field_group>
+
+    <field_group id="groupT" >
+      <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="sst"          name="tos"      long_name="sea_surface_temperature"                       />
+      <field field_ref="sst2"         name="tossq"    long_name="square_of_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="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="taum"                                                                                   />
+      <field field_ref="20d"                                                                                    />
+      <field field_ref="mldkz5"                                                                                 />
+      <field field_ref="mldr10_1"                                                                               />
+      <field field_ref="mldr10_3"                                                                               />
+      <field field_ref="mld_dt02"                                                                               />
+      <field field_ref="topthdep"                                                                               />
+      <field field_ref="pycndep"                                                                                />
+      <field field_ref="tinv"                                                                                   />
+      <field field_ref="depti"                                                                                  />
+      <field field_ref="BLT"          name="blt"      long_name="Barrier Layer Thickness"                       />
+    </field_group>
+    
+    <field_group id="groupU" >
+      <field field_ref="uoce"         name="uo"      long_name="sea_water_x_velocity"      />
+      <field field_ref="ssu"          name="uos"     long_name="sea_surface_x_velocity"    />
+      <field field_ref="utau"         name="tauuo"   long_name="surface_downward_x_stress" />
+    </field_group>
+    
+    <field_group id="groupV" >
+      <field field_ref="voce"         name="vo"      long_name="sea_water_y_velocity"      />
+      <field field_ref="ssv"          name="vos"     long_name="sea_surface_y_velocity"    />
+      <field field_ref="vtau"         name="tauvo"   long_name="surface_downward_y_stress" />
+    </field_group>
+    
+    <field_group id="groupW" >
+      <field field_ref="woce"         name="wo"       long_name="ocean vertical velocity"  />
+    </field_group>
+    
+    <field_group id="groupT1" > 
+     <field field_ref="sst"          name="sosstsst"   standard_name="sea_surface_temperature"                                 />
+     <field field_ref="sss"          name="sossssss"   standard_name="sea_surface_salinity"                                    />
+     <field field_ref="ssh"          name="sossheig"   standard_name="sea_surface_height_above_geoid"                          />
+     <field field_ref="empmr"        name="sowaflup"   standard_name="water_flux_out_of_sea_ice_and_sea_water"                 />
+     <field field_ref="qt"           name="sohefldo"   standard_name="surface_downward_heat_flux_in_sea_water"                 />
+   </field_group>
+
+   <field_group id="groupT2" >
+     <field field_ref="toce"         name="votemper"     operation="instant" freq_op="1d" > @toce_e3t / @e3t </field>
+     <field field_ref="soce"         name="vosaline"     operation="instant" freq_op="1d" > @soce_e3t / @e3t </field>
+     <field field_ref="ssh"          name="sossheig"   standard_name="sea_surface_height_above_geoid"                          />
+     <field field_ref="empmr"        name="sowaflup"   standard_name="water_flux_out_of_sea_ice_and_sea_water"                 />
+     <field field_ref="runoffs"      name="sorunoff"   standard_name=""                                                        />
+     <field field_ref="saltflx"      name="sosafldo"   standard_name="salt_flux_into_sea_water"                                />
+     <field field_ref="qt"           name="sohefldo"   standard_name="surface_downward_heat_flux_in_sea_water"                 />
+     <field field_ref="qsr"          name="soshfldo"   standard_name="downwelling_photosynthetic_radiative_flux_in_sea_water"  />
+     <field field_ref="mldkz5" name="somixhgt" standard_name="ocean_mixed_layer_thickness_defined_by_vertical_tracer_diffusivity" />
+     <field field_ref="mldr10_1"     name="somxl010"   standard_name="ocean_mixed_layer_thickness_defined_by_sigma_theta"      />
+     <field field_ref="ice_cover"    name="soicecov"   standard_name="sea_ice_area_fraction"                                   />
+     <field field_ref="wspd"         name="sowindsp"   standard_name="wind_speed"                                              />
+     <field field_ref="qrp"          name="sohefldp"   standard_name="heat_flux_into_sea_water_due_to_newtonian_relaxation"    />
+     <field field_ref="erp"          name="sowafldp"   standard_name="water_flux_out_of_sea_water_due_to_newtonian_relaxation" />
+     <field field_ref="qisf"         name="sohflisf"   standard_name=""                                                        />
+     <field field_ref="fwfisf"       name="sowflisf"   standard_name=""                                                        />
+   </field_group>
+
+   <field_group id="SPIN-UP_T" >
+          <field field_ref="e3t"          name="e3t"        standard_name="cell_thickness" />
+          <field field_ref="toce"         name="votemper"        operation="average" freq_op="10d" > @toce_e3t / @e3t </field>
+          <field field_ref="toce"         name="votemper2"       operation="average" freq_op="10d" > @toce2_e3t / @e3t </field>
+          <field field_ref="soce"         name="vosaline"        operation="average" freq_op="10d" > @soce_e3t / @e3t </field>
+          <field field_ref="soce"         name="vosaline2"       operation="average" freq_op="10d" > @soce2_e3t / @e3t </field>
+          <field field_ref="ttrd_totad"   name="opottempadvect"  operation="average" freq_op="10d" > @ttrd_totad_e3t * 1026.0 * 3991.86795711963 </field>
+          <field field_ref="ttrd_iso"     name="opottemppmdiff"  operation="average" freq_op="10d" > @ttrd_iso_e3t * 1026.0 * 3991.86795711963 </field>
+          <field field_ref="ttrd_zdfp"    name="opottempdiff"    operation="average" freq_op="10d" > @ttrd_zdfp_e3t * 1026.0 * 3991.86795711963 </field>
+          <field field_ref="ttrd_evd"     name="ttrd_evd"        operation="average" freq_op="10d" > @ttrd_evd_e3t / @e3t </field>
+          <field field_ref="ttrd_qns"     name="ttrd_qns"        operation="average" freq_op="10d" > @ttrd_qns_e3t / @e3t_surf </field>
+          <field field_ref="ttrd_qsr"     name="rsdoabsorb"      operation="average" freq_op="10d" > @ttrd_qsr_e3t * 1026.0 * 3991.86795711963 </field>
+          <field field_ref="ttrd_bbl"     name="ttrd_bbl"        operation="average" freq_op="10d" > @ttrd_bbl_e3t / @e3t </field>
+          <field field_ref="ttrd_tot"     name="opottemptend"    operation="average" freq_op="10d" > @ttrd_tot_e3t * 1026.0 * 3991.86795711963 </field>
+          <field field_ref="strd_totad"   name="osaltadvect"     operation="average" freq_op="10d" > @strd_totad_e3t * 1026.0 * 0.001 </field>
+          <field field_ref="strd_iso"     name="osaltpmdiff"     operation="average" freq_op="10d" > @strd_iso_e3t * 1026.0 * 0.001  </field>
+          <field field_ref="strd_zdfp"    name="osaltdiff"       operation="average" freq_op="10d" > @strd_zdfp_e3t * 1026.0 * 0.001  </field>
+          <field field_ref="strd_evd"     name="strd_evd"        operation="average" freq_op="10d" > @strd_evd_e3t / @e3t </field>
+          <field field_ref="strd_tot"     name="osalttend"       operation="average" freq_op="10d" > @strd_tot_e3t * 1026.0 * 0.001 </field>
+          <field field_ref="strd_bbl"     name="strd_bbl"        operation="average" freq_op="10d" > @strd_bbl_e3t / @e3t </field>
+          <field field_ref="ssh"          name="sossheig"   standard_name="sea_surface_height_above_geoid"                          />
+          <field field_ref="ssh2"         name="zossq"      standard_name="square_of_sea_surface_height_above_geoid"                />
+          <field field_ref="empmr"        name="sowaflup"   standard_name="water_flux_out_of_sea_ice_and_sea_water"                 />
+          <field field_ref="saltflx"      name="sosafldo"   standard_name="salt_flux_into_sea_water"                                />
+          <field field_ref="qt"           name="sohefldo"   standard_name="surface_downward_heat_flux_in_sea_water"                 />
+          <field field_ref="qsr"          name="soshfldo"   standard_name="downwelling_photosynthetic_radiative_flux_in_sea_water"               />
+          <field field_ref="mldkz5"       name="somixhgt"   standard_name="ocean_mixed_layer_thickness_defined_by_vertical_tracer_diffusivity"   />
+          <field field_ref="mldr10_1"     name="somxl010"   standard_name="ocean_mixed_layer_thickness_defined_by_sigma_theta"      />
+          <field field_ref="mldzint_1"    name="sokaraml"   standard_name="ocean_mixed_layer_thickness"                             />
+          <field field_ref="mldzint_2"    name="somlddbm"   standard_name="ocean_mixed_layer_thickness"                             />
+          <field field_ref="ice_cover"    name="soicecov"   standard_name="sea_ice_area_fraction"                                   />
+          <field field_ref="wspd"         name="sowindsp"   standard_name="wind_speed"                                              />
+          <field field_ref="qhcisf"       name="sohflisf"   standard_name="ice_shelf_heat_flux"                                                        />
+          <field field_ref="qlatisf"      name="soqlatisf"  standard_name="ice_shelf_latent_heat_flux"                                                        />
+          <field field_ref="fwfisf"       name="sowflisf"   standard_name="ice_shelf_melting"                                                        />
+          <field field_ref="berg_total_melt"       name="berg_total_melt"          standard_name=""                                 />
+          <field field_ref="berg_total_heat_flux"  name="berg_total_heat_flux"     standard_name=""                                 />
+          <field field_ref="runoffs"       name="sorunoff"    standard_name="water_flux_into_sea_water_from_rivers"                 />
+          <field field_ref="hflx_rain_cea" name="hfrainds"    standard_name="temperature_flux_due_to_rainfall_expressed_as_heat_flux_into_sea_water"/>
+          <field field_ref="hflx_evap_cea" name="hfevapds"    standard_name="temperature_flux_due_to_evaporation_expressed_as_heat_flux_out_of_sea_water"/>
+          <field field_ref="evap_ao_cea"   name="evap_ao_cea" standard_name="water_evaporation_flux"                                />
+          <field field_ref="rain"          name="pr"          standard_name="rainfall_flux"                                         />
+          <field field_ref="snowpre"       name="snowpre"     standard_name="snowfall_flux"                                         />
+          <field field_ref="snow_ao_cea"   name="snow_ao_cea" standard_name="snowfall_flux_over_ocean"                              />
+          <field field_ref="snow_ai_cea"   name="snow_ai_cea" standard_name="snowfall_flux_over_sea_ice"                            />
+
+   </field_group>
+
+   <field_group id="groupU1" >
+     <field field_ref="ssu"          name="sozocrtx"   standard_name="sea_surface_eastward_sea_water_velocity"                 />
+     <field field_ref="utau"         name="sozotaux"   standard_name="surface_downward_x_stress" />
+   </field_group>
+
+   <field_group id="groupU2" >
+     <field field_ref="uoce"         name="vozocrtx"     operation="instant" freq_op="1d" > @uoce_e3u / @e3u </field>
+     <field field_ref="utau"         name="sozotaux"   standard_name="surface_downward_x_stress" />
+   </field_group>
+
+   <field_group id="SPIN-UP_U" >
+          <field field_ref="e3u"          name="e3u"        standard_name="cell_thickness" />
+          <field field_ref="uoce"         name="vozocrtx"     operation="average" freq_op="10d" > @uoce_e3u / @e3u </field>
+          <field field_ref="uoce"         name="vozocrtx2"    operation="average" freq_op="10d" > @uoce2_e3u / @e3u </field>
+          <field field_ref="ut"           name="ut"           operation="average" freq_op="10d" > @ut_e3u / @e3u </field>
+          <field field_ref="us"           name="us"           operation="average" freq_op="10d" > @us_e3u / @e3u </field>
+   </field_group>
+
+   <field_group id="groupV1" >
+     <field field_ref="ssv"          name="somecrty"   standard_name="sea_surface_northward_sea_water_velocity"                 />
+     <field field_ref="vtau"         name="sometauy"   standard_name="surface_downward_y_stress" />
+   </field_group>
+
+   <field_group id="groupV2" >
+     <field field_ref="voce"         name="vomecrty"     operation="instant" freq_op="1d" > @voce_e3v / @e3v </field>
+     <field field_ref="vtau"         name="sometauy"   standard_name="surface_downward_y_stress" />   
+   </field_group>
+
+   <field_group id="SPIN-UP_V" >
+          <field field_ref="e3v"          name="e3v"        standard_name="cell_thickness" />
+          <field field_ref="voce"         name="vomecrty"     operation="average" freq_op="10d" > @voce_e3v / @e3v </field>
+          <field field_ref="voce"         name="vomecrty2"    operation="average" freq_op="10d" > @voce2_e3v / @e3v </field>
+          <field field_ref="vt"           name="vt"           operation="average" freq_op="10d" > @vt_e3v / @e3v </field>
+          <field field_ref="vs"           name="vs"           operation="average" freq_op="10d" > @vs_e3v / @e3v </field>
+          <field field_ref="vtau"         name="sometauy"   standard_name="surface_downward_y_stress" />
+   </field_group>
+
+   <field_group id="groupW2" >
+     <field field_ref="woce"         name="vovecrtz"   standard_name="upward_sea_water_velocity"                         />
+     <field field_ref="avt"          name="votkeavt"   standard_name="ocean_vertical_heat_diffusivity"                   />
+     <field field_ref="avm"          name="votkeavm"   standard_name="ocean_vertical_momentum_diffusivity"               />
+     <field field_ref="aht2d"        name="soleahtw"   standard_name="vertical_component_of_ocean_xy_tracer_diffusivity" />
+   </field_group>
+
+   <field_group id="SPIN-UP_W" >
+          <field field_ref="woce"         name="vovecrtz"   standard_name="upward_sea_water_velocity"                         />
+          <field field_ref="wt"           name="wt"         standard_name=""                                                  />
+          <field field_ref="ws"           name="ws"         standard_name=""                                                  />
+          <field field_ref="avt"          name="votkeavt"   standard_name="ocean_vertical_heat_diffusivity"                   />
+          <field field_ref="avm"          name="votkeavm"   standard_name="ocean_vertical_momentum_diffusivity"               />
+          <field field_ref="aht2d"        name="soleahtw"   standard_name="vertical_component_of_ocean_xy_tracer_diffusivity" />
+   </field_group>
+
+   <field_group id="SPIN-UP_diaptr" >
+          <field field_ref="zomsfglo"     name="zomsfglo"   standard_name="meridional_streamfunction_global"           grid_ref="gznl_W_3D"       />
+          <field field_ref="zotemglo"     name="zotemglo"   standard_name="zonal_mean_temperature_global"              grid_ref="gznl_T_3D"       />
+          <field field_ref="zosrfglo"     name="zosrfglo"   standard_name="zonal_mean_surface_global"                  grid_ref="gznl_T_3D"       />
+          <field field_ref="zosalglo"     name="zosalglo"   standard_name="zonal_mean_salinity_global"                 grid_ref="gznl_T_3D"       />
+          <field field_ref="zomsfatl"     name="zomsfatl"   standard_name="meridional_streamfunction_atlantic"         grid_ref="gznl_W_3D"       />
+          <field field_ref="zotematl"     name="zotematl"   standard_name="zonal_mean_temperature_atlantic"            grid_ref="gznl_T_3D"       />
+          <field field_ref="zosrfatl"     name="zosrfatl"   standard_name="zonal_mean_surface_atlantic"                grid_ref="gznl_T_3D"       />
+          <field field_ref="zosalatl"     name="zosalatl"   standard_name="zonal_mean_salinity_atlantic"               grid_ref="gznl_T_3D"       />
+          <field field_ref="zomsfpac"     name="zomsfpac"   standard_name="meridional_streamfunction_pacific"          grid_ref="gznl_W_3D"       />
+          <field field_ref="zotempac"     name="zotempac"   standard_name="zonal_mean_temperature_pacific"             grid_ref="gznl_T_3D"       />
+          <field field_ref="zosrfpac"     name="zosrfpac"   standard_name="zonal_mean_surface_pacific"                 grid_ref="gznl_T_3D"       />
+          <field field_ref="zosalpac"     name="zosalpac"   standard_name="zonal_mean_salinity_pacific"                grid_ref="gznl_T_3D"       />
+          <field field_ref="zomsfind"     name="zomsfind"   standard_name="meridional_streamfunction_indian"           grid_ref="gznl_W_3D"       />
+          <field field_ref="zotemind"     name="zotemind"   standard_name="zonal_mean_temperature_indian"              grid_ref="gznl_T_3D"       />
+          <field field_ref="zosrfind"     name="zosrfind"   standard_name="zonal_mean_surface_indian"                  grid_ref="gznl_T_3D"       />
+          <field field_ref="zosalind"     name="zosalind"   standard_name="zonal_mean_salinity_indian"                 grid_ref="gznl_T_3D"       />
+          <field field_ref="zomsfipc"     name="zomsfipc"   standard_name="meridional_streamfunction_indian_pacific"   grid_ref="gznl_W_3D"       />
+          <field field_ref="zotemipc"     name="zotemipc"   standard_name="zonal_mean_temperature_indian_pacific"      grid_ref="gznl_T_3D"       />
+          <field field_ref="zosrfipc"     name="zosrfipc"   standard_name="zonal_mean_surface_indian_pacific"          grid_ref="gznl_T_3D"       />
+          <field field_ref="zosalipc"     name="zosalipc"   standard_name="zonal_mean_salinity_indian_pacific"         grid_ref="gznl_T_3D"       />
+          <field field_ref="sophtadv"     name="sophtadv"   standard_name="advective_heat_transport"                   grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstadv"     name="sopstadv"   standard_name="advective_salt_transport"                   grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtldf"     name="sophtldf"   standard_name="diffusive_heat_transport"                   grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstldf"     name="sopstldf"   standard_name="diffusive_salt_transport"                   grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtadv_atl" name="sophtadv_atl"   standard_name="advective_heat_transport_atlantic"      grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstadv_atl" name="sopstadv_atl"   standard_name="advective_salt_transport_atlantic"      grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtldf_atl" name="sophtldf_atl"   standard_name="diffusive_heat_transport_atlantic"      grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstldf_atl" name="sopstldf_atl"   standard_name="diffusive_salt_transport_atlantic"      grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtadv_pac" name="sophtadv_pac"   standard_name="advective_heat_transport_pacific"       grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstadv_pac" name="sopstadv_pac"   standard_name="advective_salt_transport_pacific"       grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtldf_pac" name="sophtldf_pac"   standard_name="diffusive_heat_transport_pacific"       grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstldf_pac" name="sopstldf_pac"   standard_name="diffusive_salt_transport_pacific"       grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtadv_ind" name="sophtadv_ind"   standard_name="advective_heat_transport_indian"        grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstadv_ind" name="sopstadv_ind"   standard_name="advective_salt_transport_indian"        grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtldf_ind" name="sophtldf_ind"   standard_name="diffusive_heat_transport_indian"        grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstldf_ind" name="sopstldf_ind"   standard_name="diffusive_salt_transport_indian"        grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtadv_ipc" name="sophtadv_ipc"   standard_name="advective_heat_transport_indopacific"   grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstadv_ipc" name="sopstadv_ipc"   standard_name="advective_salt_transport_indopacific"   grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtldf_ipc" name="sophtldf_ipc"   standard_name="diffusive_heat_transport_indopacific"   grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstldf_ipc" name="sopstldf_ipc"   standard_name="diffusive_salt_transport_indopacific"   grid_ref="gznl_T_2D"       />
+   </field_group>
+
+  </field_definition>
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/iodef_medusa_et_al.xml
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/iodef_medusa_et_al.xml	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/iodef_medusa_et_al.xml	(revision 8201)
@@ -0,0 +1,448 @@
+<!-- GO6.0 version of the XIOS namelist -->
+<!-- XIOS version 2 -->
+<?xml version="1.0"?>
+
+<simulation> 
+
+ <context id="nemo">
+    
+    <!-- $id$ -->
+    
+    <!-- 
+============================================================================================================
+=                                  definition of all existing variables                                    =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+    <field_definition src="./field_def_bgc.xml"/>
+    <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="1mo" 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="10d" output_freq="10d" output_level="10" enabled=".TRUE."> <!-- 10d files -->
+
+	<file id="file1" name_suffix="_grid_T" description="ocean T grid variables" >
+          <field field_ref="e3t"          name="e3t"        standard_name="cell_thickness" />
+          <field field_ref="toce"         name="votemper"        operation="average" freq_op="1mo" > @toce_e3t / @e3t </field>
+          <field field_ref="toce"         name="votemper2"       operation="average" freq_op="1mo" > @toce2_e3t / @e3t </field>
+          <field field_ref="soce"         name="vosaline"        operation="average" freq_op="1mo" > @soce_e3t / @e3t </field>
+          <field field_ref="soce"         name="vosaline2"       operation="average" freq_op="1mo" > @soce2_e3t / @e3t </field>
+          <field field_ref="ttrd_totad"   name="opottempadvect"  operation="average" freq_op="1mo" > @ttrd_totad_e3t * 1026.0 * 3991.86795711963 </field>
+          <field field_ref="ttrd_iso"     name="opottemppmdiff"  operation="average" freq_op="1mo" > @ttrd_iso_e3t * 1026.0 * 3991.86795711963 </field>
+          <field field_ref="ttrd_zdfp"    name="opottempdiff"    operation="average" freq_op="1mo" > @ttrd_zdfp_e3t * 1026.0 * 3991.86795711963 </field>
+          <field field_ref="ttrd_evd"     name="ttrd_evd"        operation="average" freq_op="1mo" > @ttrd_evd_e3t / @e3t </field>
+          <field field_ref="ttrd_qns"     name="ttrd_qns"        operation="average" freq_op="1mo" > @ttrd_qns_e3t / @e3t_surf </field>
+          <field field_ref="ttrd_qsr"     name="rsdoabsorb"      operation="average" freq_op="1mo" > @ttrd_qsr_e3t * 1026.0 * 3991.86795711963 </field>
+          <field field_ref="ttrd_bbl"     name="ttrd_bbl"        operation="average" freq_op="1mo" > @ttrd_bbl_e3t / @e3t </field>
+          <field field_ref="ttrd_tot"     name="opottemptend"    operation="average" freq_op="1mo" > @ttrd_tot_e3t * 1026.0 * 3991.86795711963 </field>
+          <field field_ref="strd_totad"   name="osaltadvect"     operation="average" freq_op="1mo" > @strd_totad_e3t * 1026.0 * 0.001 </field>
+          <field field_ref="strd_iso"     name="osaltpmdiff"     operation="average" freq_op="1mo" > @strd_iso_e3t * 1026.0 * 0.001  </field>
+          <field field_ref="strd_zdfp"    name="osaltdiff"       operation="average" freq_op="1mo" > @strd_zdfp_e3t * 1026.0 * 0.001  </field>
+          <field field_ref="strd_evd"     name="strd_evd"        operation="average" freq_op="1mo" > @strd_evd_e3t / @e3t </field>
+          <field field_ref="strd_tot"     name="osalttend"       operation="average" freq_op="1mo" > @strd_tot_e3t * 1026.0 * 0.001 </field>
+          <field field_ref="strd_bbl"     name="strd_bbl"        operation="average" freq_op="1mo" > @strd_bbl_e3t / @e3t </field>
+	  <field field_ref="ssh"          name="sossheig"   standard_name="sea_surface_height_above_geoid"                          />
+          <field field_ref="ssh2"         name="zossq"      standard_name="square_of_sea_surface_height_above_geoid"                />
+	  <field field_ref="empmr"        name="sowaflup"   standard_name="water_flux_out_of_sea_ice_and_sea_water"                 />
+	  <field field_ref="saltflx"      name="sosafldo"   standard_name="salt_flux_into_sea_water"                                />
+	  <field field_ref="qt"           name="sohefldo"   standard_name="surface_downward_heat_flux_in_sea_water"                 />
+	  <field field_ref="qsr"          name="soshfldo"   standard_name="downwelling_photosynthetic_radiative_flux_in_sea_water"               />
+          <field field_ref="mldkz5"       name="somixhgt"   standard_name="ocean_mixed_layer_thickness_defined_by_vertical_tracer_diffusivity"   />
+          <field field_ref="mldr10_1"     name="somxl010"   standard_name="ocean_mixed_layer_thickness_defined_by_sigma_theta"      />
+          <field field_ref="mldzint_1"    name="sokaraml"   standard_name="ocean_mixed_layer_thickness"                             />
+          <field field_ref="mldzint_2"    name="somlddbm"   standard_name="ocean_mixed_layer_thickness"                             />
+          <field field_ref="ice_cover"    name="soicecov"   standard_name="sea_ice_area_fraction"                                   />
+          <field field_ref="wspd"         name="sowindsp"   standard_name="wind_speed"                                              />          
+          <field field_ref="qhcisf"       name="sohflisf"   standard_name="ice_shelf_heat_flux"                                                        />
+          <field field_ref="qlatisf"      name="soqlatisf"  standard_name="ice_shelf_latent_heat_flux"                                                        />
+          <field field_ref="fwfisf"       name="sowflisf"   standard_name="ice_shelf_melting"                                                        />
+          <field field_ref="berg_total_melt"       name="berg_total_melt"          standard_name=""                                 />
+          <field field_ref="berg_total_heat_flux"  name="berg_total_heat_flux"     standard_name=""                                 />
+          <field field_ref="runoffs"       name="sorunoff"    standard_name="water_flux_into_sea_water_from_rivers"                 />
+          <field field_ref="hflx_rain_cea" name="hfrainds"    standard_name="temperature_flux_due_to_rainfall_expressed_as_heat_flux_into_sea_water"/>
+          <field field_ref="hflx_evap_cea" name="hfevapds"    standard_name="temperature_flux_due_to_evaporation_expressed_as_heat_flux_out_of_sea_water"/>
+          <field field_ref="evap_ao_cea"   name="evap_ao_cea" standard_name="water_evaporation_flux"                                />
+          <field field_ref="rain"          name="pr"          standard_name="rainfall_flux"                                         />
+          <field field_ref="snowpre"       name="snowpre"     standard_name="snowfall_flux"                                         />
+          <field field_ref="snow_ao_cea"   name="snow_ao_cea" standard_name="snowfall_flux_over_ocean"                              />
+          <field field_ref="snow_ai_cea"   name="snow_ai_cea" standard_name="snowfall_flux_over_sea_ice"                            />
+	</file>
+	
+	<file id="file2" name_suffix="_grid_U" description="ocean U grid variables" >
+          <field field_ref="e3u"          name="e3u"        standard_name="cell_thickness" />
+          <field field_ref="uoce"         name="vozocrtx"     operation="average" freq_op="1mo" > @uoce_e3u / @e3u </field>
+          <field field_ref="uoce"         name="vozocrtx2"    operation="average" freq_op="1mo" > @uoce2_e3u / @e3u </field>
+          <field field_ref="ut"           name="ut"           operation="average" freq_op="1mo" > @ut_e3u / @e3u </field>
+          <field field_ref="us"           name="us"           operation="average" freq_op="1mo" > @us_e3u / @e3u </field>
+	  <field field_ref="utau"         name="sozotaux"   standard_name="surface_downward_x_stress" />
+	</file>
+	
+	<file id="file3" name_suffix="_grid_V" description="ocean V grid variables" >
+          <field field_ref="e3v"          name="e3v"        standard_name="cell_thickness" />
+          <field field_ref="voce"         name="vomecrty"     operation="average" freq_op="1mo" > @voce_e3v / @e3v </field>
+          <field field_ref="voce"         name="vomecrty2"    operation="average" freq_op="1mo" > @voce2_e3v / @e3v </field>
+          <field field_ref="vt"           name="vt"           operation="average" freq_op="1mo" > @vt_e3v / @e3v </field>
+          <field field_ref="vs"           name="vs"           operation="average" freq_op="1mo" > @vs_e3v / @e3v </field>
+	  <field field_ref="vtau"         name="sometauy"   standard_name="surface_downward_y_stress" />
+	</file>
+	
+	<file id="file4" name_suffix="_grid_W" description="ocean W grid variables" >
+	  <field field_ref="woce"         name="vovecrtz"   standard_name="upward_sea_water_velocity"                         />
+          <field field_ref="wt"           name="wt"         standard_name=""                                                  />
+          <field field_ref="ws"           name="ws"         standard_name=""                                                  />
+	  <field field_ref="avt"          name="votkeavt"   standard_name="ocean_vertical_heat_diffusivity"                   />
+          <field field_ref="avm"          name="votkeavm"   standard_name="ocean_vertical_momentum_diffusivity"               />
+          <field field_ref="aht2d"        name="soleahtw"   standard_name="vertical_component_of_ocean_xy_tracer_diffusivity" />
+	</file>
+        
+        <file id="file5" name_suffix="_diaptr" description="processed diagnostics" >
+	  <field field_ref="zomsfglo"     name="zomsfglo"   standard_name="meridional_streamfunction_global"           grid_ref="gznl_W_3D"       />
+          <field field_ref="zotemglo"     name="zotemglo"   standard_name="zonal_mean_temperature_global"              grid_ref="gznl_T_3D"       />
+          <field field_ref="zosrfglo"     name="zosrfglo"   standard_name="zonal_mean_surface_global"                  grid_ref="gznl_T_3D"       />
+	  <field field_ref="zosalglo"     name="zosalglo"   standard_name="zonal_mean_salinity_global"                 grid_ref="gznl_T_3D"       />          
+          <field field_ref="zomsfatl"     name="zomsfatl"   standard_name="meridional_streamfunction_atlantic"         grid_ref="gznl_W_3D"       />
+          <field field_ref="zotematl"     name="zotematl"   standard_name="zonal_mean_temperature_atlantic"            grid_ref="gznl_T_3D"       />
+          <field field_ref="zosrfatl"     name="zosrfatl"   standard_name="zonal_mean_surface_atlantic"                grid_ref="gznl_T_3D"       />
+	  <field field_ref="zosalatl"     name="zosalatl"   standard_name="zonal_mean_salinity_atlantic"               grid_ref="gznl_T_3D"       />          
+          <field field_ref="zomsfpac"     name="zomsfpac"   standard_name="meridional_streamfunction_pacific"          grid_ref="gznl_W_3D"       />
+          <field field_ref="zotempac"     name="zotempac"   standard_name="zonal_mean_temperature_pacific"             grid_ref="gznl_T_3D"       />
+          <field field_ref="zosrfpac"     name="zosrfpac"   standard_name="zonal_mean_surface_pacific"                 grid_ref="gznl_T_3D"       />
+	  <field field_ref="zosalpac"     name="zosalpac"   standard_name="zonal_mean_salinity_pacific"                grid_ref="gznl_T_3D"       />
+          <field field_ref="zomsfind"     name="zomsfind"   standard_name="meridional_streamfunction_indian"           grid_ref="gznl_W_3D"       />
+          <field field_ref="zotemind"     name="zotemind"   standard_name="zonal_mean_temperature_indian"              grid_ref="gznl_T_3D"       />
+          <field field_ref="zosrfind"     name="zosrfind"   standard_name="zonal_mean_surface_indian"                  grid_ref="gznl_T_3D"       />
+	  <field field_ref="zosalind"     name="zosalind"   standard_name="zonal_mean_salinity_indian"                 grid_ref="gznl_T_3D"       />          
+          <field field_ref="zomsfipc"     name="zomsfipc"   standard_name="meridional_streamfunction_indian_pacific"   grid_ref="gznl_W_3D"       />
+          <field field_ref="zotemipc"     name="zotemipc"   standard_name="zonal_mean_temperature_indian_pacific"      grid_ref="gznl_T_3D"       />
+          <field field_ref="zosrfipc"     name="zosrfipc"   standard_name="zonal_mean_surface_indian_pacific"          grid_ref="gznl_T_3D"       />
+	  <field field_ref="zosalipc"     name="zosalipc"   standard_name="zonal_mean_salinity_indian_pacific"         grid_ref="gznl_T_3D"       />          
+          <field field_ref="sophtadv"     name="sophtadv"   standard_name="advective_heat_transport"                   grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstadv"     name="sopstadv"   standard_name="advective_salt_transport"                   grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtldf"     name="sophtldf"   standard_name="diffusive_heat_transport"                   grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstldf"     name="sopstldf"   standard_name="diffusive_salt_transport"                   grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtadv_atl" name="sophtadv_atl"   standard_name="advective_heat_transport_atlantic"      grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstadv_atl" name="sopstadv_atl"   standard_name="advective_salt_transport_atlantic"      grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtldf_atl" name="sophtldf_atl"   standard_name="diffusive_heat_transport_atlantic"      grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstldf_atl" name="sopstldf_atl"   standard_name="diffusive_salt_transport_atlantic"      grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtadv_pac" name="sophtadv_pac"   standard_name="advective_heat_transport_pacific"       grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstadv_pac" name="sopstadv_pac"   standard_name="advective_salt_transport_pacific"       grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtldf_pac" name="sophtldf_pac"   standard_name="diffusive_heat_transport_pacific"       grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstldf_pac" name="sopstldf_pac"   standard_name="diffusive_salt_transport_pacific"       grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtadv_ind" name="sophtadv_ind"   standard_name="advective_heat_transport_indian"        grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstadv_ind" name="sopstadv_ind"   standard_name="advective_salt_transport_indian"        grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtldf_ind" name="sophtldf_ind"   standard_name="diffusive_heat_transport_indian"        grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstldf_ind" name="sopstldf_ind"   standard_name="diffusive_salt_transport_indian"        grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtadv_ipc" name="sophtadv_ipc"   standard_name="advective_heat_transport_indopacific"   grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstadv_ipc" name="sopstadv_ipc"   standard_name="advective_salt_transport_indopacific"   grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtldf_ipc" name="sophtldf_ipc"   standard_name="diffusive_heat_transport_indopacific"   grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstldf_ipc" name="sopstldf_ipc"   standard_name="diffusive_salt_transport_indopacific"   grid_ref="gznl_T_2D"       />
+	</file>
+
+        <file id="file6" name_suffix="_ptrc_T" description="Medusa sms variables" >
+          <field_group group_ref="groupMEDUSA" />
+          <field_group group_ref="groupIDTRA" />
+          <field_group group_ref="groupCFC" />
+          <field_group group_ref="groupAGE" />
+        </file>
+
+        <file id="file7" name_suffix="_diad_T" description="Medusa diagnostic variables" >
+          <field_group group_ref="groupMEDUSA_dia" /> 
+          <field_group group_ref="groupMEDUSA_3dd" /> 
+          <field_group group_ref="groupMEDUSA_dms" />
+          <field_group group_ref="groupIDTRA_dia" />
+          <field_group group_ref="groupCFC_dia" />
+          <field_group group_ref="groupMEDUSA_cmip6" />
+        </file>
+       
+      </file_group>
+      
+  
+      <file_group id="1m" output_freq="1mo" split_freq="1mo" output_level="10" enabled=".FALSE."> <!-- 1mo files -->   
+      <!-- <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE.">  - 1mo files -->   
+
+        <file id="file9" name_suffix="_grid_T" description="ocean T grid variables" >
+          <field field_ref="e3t"          name="e3t"        standard_name="cell_thickness" />
+          <field field_ref="toce"         name="votemper"        operation="average" freq_op="1mo" > @toce_e3t / @e3t </field>
+          <field field_ref="toce"         name="votemper2"       operation="average" freq_op="1mo" > @toce2_e3t / @e3t </field>
+          <field field_ref="soce"         name="vosaline"        operation="average" freq_op="1mo" > @soce_e3t / @e3t </field>
+          <field field_ref="soce"         name="vosaline2"       operation="average" freq_op="1mo" > @soce2_e3t / @e3t </field>
+          <field field_ref="ttrd_totad"   name="opottempadvect"  operation="average" freq_op="1mo" > @ttrd_totad_e3t * 1026.0 * 3991.86795711963 </field>
+          <field field_ref="ttrd_iso"     name="opottemppmdiff"  operation="average" freq_op="1mo" > @ttrd_iso_e3t * 1026.0 * 3991.86795711963 </field>
+          <field field_ref="ttrd_zdfp"    name="opottempdiff"    operation="average" freq_op="1mo" > @ttrd_zdfp_e3t * 1026.0 * 3991.86795711963 </field>
+          <field field_ref="ttrd_evd"     name="ttrd_evd"        operation="average" freq_op="1mo" > @ttrd_evd_e3t / @e3t </field>
+          <field field_ref="ttrd_qns"     name="ttrd_qns"        operation="average" freq_op="1mo" > @ttrd_qns_e3t / @e3t_surf </field>
+          <field field_ref="ttrd_qsr"     name="rsdoabsorb"      operation="average" freq_op="1mo" > @ttrd_qsr_e3t * 1026.0 * 3991.86795711963 </field>
+          <field field_ref="ttrd_bbl"     name="ttrd_bbl"        operation="average" freq_op="1mo" > @ttrd_bbl_e3t / @e3t </field>
+          <field field_ref="ttrd_tot"     name="opottemptend"    operation="average" freq_op="1mo" > @ttrd_tot_e3t * 1026.0 * 3991.86795711963 </field>
+          <field field_ref="strd_totad"   name="osaltadvect"     operation="average" freq_op="1mo" > @strd_totad_e3t * 1026.0 * 0.001 </field>
+          <field field_ref="strd_iso"     name="osaltpmdiff"     operation="average" freq_op="1mo" > @strd_iso_e3t * 1026.0 * 0.001  </field>
+          <field field_ref="strd_zdfp"    name="osaltdiff"       operation="average" freq_op="1mo" > @strd_zdfp_e3t * 1026.0 * 0.001  </field>
+          <field field_ref="strd_evd"     name="strd_evd"        operation="average" freq_op="1mo" > @strd_evd_e3t / @e3t </field>
+          <field field_ref="strd_tot"     name="osalttend"       operation="average" freq_op="1mo" > @strd_tot_e3t * 1026.0 * 0.001 </field>
+          <field field_ref="strd_bbl"     name="strd_bbl"        operation="average" freq_op="1mo" > @strd_bbl_e3t / @e3t </field>
+          <field field_ref="ssh"          name="sossheig"   standard_name="sea_surface_height_above_geoid"                          />
+          <field field_ref="ssh2"         name="zossq"      standard_name="square_of_sea_surface_height_above_geoid"                />
+          <field field_ref="empmr"        name="sowaflup"   standard_name="water_flux_out_of_sea_ice_and_sea_water"                 />
+          <field field_ref="saltflx"      name="sosafldo"   standard_name="salt_flux_into_sea_water"                                />
+          <field field_ref="qt"           name="sohefldo"   standard_name="surface_downward_heat_flux_in_sea_water"                 />
+          <field field_ref="qsr"          name="soshfldo"   standard_name="downwelling_photosynthetic_radiative_flux_in_sea_water"               />
+          <field field_ref="mldkz5"       name="somixhgt"   standard_name="ocean_mixed_layer_thickness_defined_by_vertical_tracer_diffusivity"   />
+          <field field_ref="mldr10_1"     name="somxl010"   standard_name="ocean_mixed_layer_thickness_defined_by_sigma_theta"      />
+          <field field_ref="mldzint_1"    name="sokaraml"   standard_name="ocean_mixed_layer_thickness"                             />
+          <field field_ref="mldzint_2"    name="somlddbm"   standard_name="ocean_mixed_layer_thickness"                             />
+          <field field_ref="ice_cover"    name="soicecov"   standard_name="sea_ice_area_fraction"                                   />
+          <field field_ref="wspd"         name="sowindsp"   standard_name="wind_speed"                                              />
+          <field field_ref="qhcisf"       name="sohflisf"   standard_name="ice_shelf_heat_flux"                                                        />
+          <field field_ref="qlatisf"      name="soqlatisf"  standard_name="ice_shelf_latent_heat_flux"                                                        />
+          <field field_ref="fwfisf"       name="sowflisf"   standard_name="ice_shelf_melting"                                                        />
+          <field field_ref="berg_total_melt"       name="berg_total_melt"          standard_name=""                                 />
+          <field field_ref="berg_total_heat_flux"  name="berg_total_heat_flux"     standard_name=""                                 />
+          <field field_ref="runoffs"       name="sorunoff"    standard_name="water_flux_into_sea_water_from_rivers"                 />
+          <field field_ref="hflx_rain_cea" name="hfrainds"    standard_name="temperature_flux_due_to_rainfall_expressed_as_heat_flux_into_sea_water"/>
+          <field field_ref="hflx_evap_cea" name="hfevapds"    standard_name="temperature_flux_due_to_evaporation_expressed_as_heat_flux_out_of_sea_water"/>
+          <field field_ref="evap_ao_cea"   name="evap_ao_cea" standard_name="water_evaporation_flux"                                />
+          <field field_ref="rain"          name="pr"          standard_name="rainfall_flux"                                         />
+          <field field_ref="snowpre"       name="snowpre"     standard_name="snowfall_flux"                                         />
+          <field field_ref="snow_ao_cea"   name="snow_ao_cea" standard_name="snowfall_flux_over_ocean"                              />
+          <field field_ref="snow_ai_cea"   name="snow_ai_cea" standard_name="snowfall_flux_over_sea_ice"                            />
+        </file>
+
+	<file id="file10" name_suffix="_grid_U" description="ocean U grid variables" >
+          <field field_ref="e3u"          name="e3u"        standard_name="cell_thickness" />
+          <field field_ref="uoce"         name="vozocrtx"     operation="average" freq_op="1mo" > @uoce_e3u / @e3u </field>
+          <field field_ref="uoce"         name="vozocrtx2"    operation="average" freq_op="1mo" > @uoce2_e3u / @e3u </field>
+          <field field_ref="ut"           name="ut"           operation="average" freq_op="1mo" > @ut_e3u / @e3u </field>
+          <field field_ref="us"           name="us"           operation="average" freq_op="1mo" > @us_e3u / @e3u </field>
+          <field field_ref="utau"         name="sozotaux"   standard_name="surface_downward_x_stress" />
+        </file>
+
+	<file id="file11" name_suffix="_grid_V" description="ocean V grid variables" >
+          <field field_ref="e3v"          name="e3v"        standard_name="cell_thickness" />
+          <field field_ref="voce"         name="vomecrty"     operation="average" freq_op="1mo" > @voce_e3v / @e3v </field>
+          <field field_ref="voce"         name="vomecrty2"    operation="average" freq_op="1mo" > @voce2_e3v / @e3v </field>
+          <field field_ref="vt"           name="vt"           operation="average" freq_op="1mo" > @vt_e3v / @e3v </field>
+          <field field_ref="vs"           name="vs"           operation="average" freq_op="1mo" > @vs_e3v / @e3v </field>
+          <field field_ref="vtau"         name="sometauy"   standard_name="surface_downward_y_stress" />
+        </file>
+
+	<file id="file12" name_suffix="_grid_W" description="ocean W grid variables" >
+          <field field_ref="woce"         name="vovecrtz"   standard_name="upward_sea_water_velocity"                         />
+          <field field_ref="wt"           name="wt"         standard_name=""                                                  />
+          <field field_ref="ws"           name="ws"         standard_name=""                                                  />
+          <field field_ref="avt"          name="votkeavt"   standard_name="ocean_vertical_heat_diffusivity"                   />
+          <field field_ref="avm"          name="votkeavm"   standard_name="ocean_vertical_momentum_diffusivity"               />
+          <field field_ref="aht2d"        name="soleahtw"   standard_name="vertical_component_of_ocean_xy_tracer_diffusivity" />
+        </file>
+
+	<file id="file13" name_suffix="_grid_W" description="ocean W grid variables" >
+          <field field_ref="zomsfglo"     name="zomsfglo"   standard_name="meridional_streamfunction_global"           grid_ref="gznl_W_3D"       />
+          <field field_ref="zotemglo"     name="zotemglo"   standard_name="zonal_mean_temperature_global"              grid_ref="gznl_T_3D"       />
+          <field field_ref="zosrfglo"     name="zosrfglo"   standard_name="zonal_mean_surface_global"                  grid_ref="gznl_T_3D"       />
+          <field field_ref="zosalglo"     name="zosalglo"   standard_name="zonal_mean_salinity_global"                 grid_ref="gznl_T_3D"       />
+          <field field_ref="zomsfatl"     name="zomsfatl"   standard_name="meridional_streamfunction_atlantic"         grid_ref="gznl_W_3D"       />
+          <field field_ref="zotematl"     name="zotematl"   standard_name="zonal_mean_temperature_atlantic"            grid_ref="gznl_T_3D"       />
+          <field field_ref="zosrfatl"     name="zosrfatl"   standard_name="zonal_mean_surface_atlantic"                grid_ref="gznl_T_3D"       />
+          <field field_ref="zosalatl"     name="zosalatl"   standard_name="zonal_mean_salinity_atlantic"               grid_ref="gznl_T_3D"       />
+          <field field_ref="zomsfpac"     name="zomsfpac"   standard_name="meridional_streamfunction_pacific"          grid_ref="gznl_W_3D"       />
+          <field field_ref="zotempac"     name="zotempac"   standard_name="zonal_mean_temperature_pacific"             grid_ref="gznl_T_3D"       />
+          <field field_ref="zosrfpac"     name="zosrfpac"   standard_name="zonal_mean_surface_pacific"                 grid_ref="gznl_T_3D"       />
+          <field field_ref="zosalpac"     name="zosalpac"   standard_name="zonal_mean_salinity_pacific"                grid_ref="gznl_T_3D"       />
+          <field field_ref="zomsfind"     name="zomsfind"   standard_name="meridional_streamfunction_indian"           grid_ref="gznl_W_3D"       />
+          <field field_ref="zotemind"     name="zotemind"   standard_name="zonal_mean_temperature_indian"              grid_ref="gznl_T_3D"       />
+          <field field_ref="zosrfind"     name="zosrfind"   standard_name="zonal_mean_surface_indian"                  grid_ref="gznl_T_3D"       />
+          <field field_ref="zosalind"     name="zosalind"   standard_name="zonal_mean_salinity_indian"                 grid_ref="gznl_T_3D"       />
+          <field field_ref="zomsfipc"     name="zomsfipc"   standard_name="meridional_streamfunction_indian_pacific"   grid_ref="gznl_W_3D"       />
+          <field field_ref="zotemipc"     name="zotemipc"   standard_name="zonal_mean_temperature_indian_pacific"      grid_ref="gznl_T_3D"       />
+          <field field_ref="zosrfipc"     name="zosrfipc"   standard_name="zonal_mean_surface_indian_pacific"          grid_ref="gznl_T_3D"       />
+          <field field_ref="zosalipc"     name="zosalipc"   standard_name="zonal_mean_salinity_indian_pacific"         grid_ref="gznl_T_3D"       />
+          <field field_ref="sophtadv"     name="sophtadv"   standard_name="advective_heat_transport"                   grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstadv"     name="sopstadv"   standard_name="advective_salt_transport"                   grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtldf"     name="sophtldf"   standard_name="diffusive_heat_transport"                   grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstldf"     name="sopstldf"   standard_name="diffusive_salt_transport"                   grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtadv_atl" name="sophtadv_atl"   standard_name="advective_heat_transport_atlantic"      grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstadv_atl" name="sopstadv_atl"   standard_name="advective_salt_transport_atlantic"      grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtldf_atl" name="sophtldf_atl"   standard_name="diffusive_heat_transport_atlantic"      grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstldf_atl" name="sopstldf_atl"   standard_name="diffusive_salt_transport_atlantic"      grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtadv_pac" name="sophtadv_pac"   standard_name="advective_heat_transport_pacific"       grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstadv_pac" name="sopstadv_pac"   standard_name="advective_salt_transport_pacific"       grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtldf_pac" name="sophtldf_pac"   standard_name="diffusive_heat_transport_pacific"       grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstldf_pac" name="sopstldf_pac"   standard_name="diffusive_salt_transport_pacific"       grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtadv_ind" name="sophtadv_ind"   standard_name="advective_heat_transport_indian"        grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstadv_ind" name="sopstadv_ind"   standard_name="advective_salt_transport_indian"        grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtldf_ind" name="sophtldf_ind"   standard_name="diffusive_heat_transport_indian"        grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstldf_ind" name="sopstldf_ind"   standard_name="diffusive_salt_transport_indian"        grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtadv_ipc" name="sophtadv_ipc"   standard_name="advective_heat_transport_indopacific"   grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstadv_ipc" name="sopstadv_ipc"   standard_name="advective_salt_transport_indopacific"   grid_ref="gznl_T_2D"       />
+          <field field_ref="sophtldf_ipc" name="sophtldf_ipc"   standard_name="diffusive_heat_transport_indopacific"   grid_ref="gznl_T_2D"       />
+          <field field_ref="sopstldf_ipc" name="sopstldf_ipc"   standard_name="diffusive_salt_transport_indopacific"   grid_ref="gznl_T_2D"       />
+        </file>
+
+        <file id="file14" name_suffix="_ptrc_T" description="Medusa sms variables" >
+          <field_group group_ref="groupMEDUSA" />
+          <field_group group_ref="groupIDTRA" />
+          <field_group group_ref="groupCFC" />
+          <field_group group_ref="groupAGE" />
+        </file>
+
+        <file id="file15" name_suffix="_diad_T" description="Medusa diagnostic variables" >
+          <field_group group_ref="groupMEDUSA_dia" /> 
+          <field_group group_ref="groupMEDUSA_3dd" /> 
+          <field_group group_ref="groupMEDUSA_dms" />
+          <field_group group_ref="groupIDTRA_dia" />
+          <field_group group_ref="groupCFC_dia" />
+          <field_group group_ref="groupMEDUSA_cmip6" />
+        </file>
+
+      </file_group>
+
+      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files -->
+      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files -->
+      <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files -->
+      <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files -->
+
+      <file_group id="1y"  output_freq="1y" output_level="10" enabled=".TRUE."/> <!-- real yearly files -->
+      <file_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" standard_name="depth" long_name="Vertical T levels" unit="m" positive="down" />
+      <axis id="depthu" standard_name="depth" long_name="Vertical U levels" unit="m" positive="down" />
+      <axis id="depthv" standard_name="depth" long_name="Vertical V levels" unit="m" positive="down" />
+      <axis id="depthw" standard_name="depth" 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 id="ncatice" long_name="Ice category"       unit="1"               />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"            />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"            />
+      <axis id="deptht_surface" axis_ref="deptht" >
+         <zoom_axis begin=" 1 " n=" 1 " />
+      </axis>
+
+   </axis_definition>
+    
+   <domain_definition src="./domain_def.xml"/>
+   
+    <grid_definition>
+        <!--  -->
+       <grid id="grid_T_2D" >
+         <domain id="grid_T" />
+       </grid>
+        <!--  -->
+       <grid id="grid_T_3D_ncatice" >
+         <domain id="grid_T" />
+         <axis id="ncatice" />
+       </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="grid_1point" >
+         <domain id="1point"/>
+       </grid>
+        <!--  -->
+       <grid id="grid_T_nfloat" >
+         <domain id="grid_T" />
+         <axis id="nfloat" />
+       </grid>
+        <!--  -->
+       <grid id="grid_EqT" >
+         <domain id="EqT" />
+       </grid>
+        <!--  -->
+       <grid id="gznl_T_2D">
+         <domain id="ptr" />
+       </grid>
+        <!--  -->
+       <grid id="gznl_T_3D">
+         <domain id="ptr" />
+         <axis id="deptht" />
+       </grid>
+        <!--  -->
+       <grid id="gznl_W_2D">
+         <domain id="ptr" />
+       </grid>
+        <!--  -->
+       <grid id="gznl_W_3D">
+         <domain id="ptr" />
+         <axis id="depthw" />
+       </grid>
+        <!--  -->
+       <grid id="grid_T_surface_extract">
+         <domain domain_ref="grid_T" />
+         <axis   axis_ref="deptht_surface" />
+       </grid>
+
+    </grid_definition>
+  </context>
+  
+
+  <context id="xios">
+
+      <variable_definition>
+	
+	  <variable id="info_level"            type="int">0</variable>
+	  <variable id="using_server"          type="bool">false</variable>
+	  <variable id="using_oasis"           type="bool">true</variable>
+	  <variable id="oasis_codes_id"        type="string" >toyoce</variable>
+	
+      </variable_definition>
+               
+  </context>
+  
+</simulation>
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/namelist_age_ref
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/namelist_age_ref	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/namelist_age_ref	(revision 8201)
@@ -0,0 +1,9 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! AGE  :       1  - dates                                 (namage)
+!! namelists
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&namage     !   dates
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   rn_age_depth       = 10            ! depth over which age tracer reset to zero
+   rn_age_kill_rate   = -0.000138888  !  = -1/7200 recip of relaxation timescale (s) for  age tracer shallower than age_depth
+/
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/namelist_cfc_ref
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/namelist_cfc_ref	(revision 8200)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/namelist_cfc_ref	(revision 8201)
@@ -7,5 +7,7 @@
 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    ndate_beg  = 300101    !  datedeb1
-   nyear_res  = 1932      !  iannee1
+   nyear_res  = 1600      !  iannee1
+   simu_type  = 1         ! kind of Simulation: 1 = SPIN-UP (90y-cycle)
+!!                                           !! 2 = Hindcast/proj (100y cycle)
 /
 !'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/namelist_cfc_v1_ref
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/namelist_cfc_v1_ref	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/namelist_cfc_v1_ref	(revision 8201)
@@ -0,0 +1,20 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! CFC  :       1  - dates                                 (namcfcdate)
+!! namelists    
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&namcfcdate     !   dates
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   ndate_beg  = 300101    !  datedeb1
+   nyear_res  = 1600      !  iannee1
+   simu_type  = 1         ! kind of Simulation: 1 = SPIN-UP (90y-cycle)
+!!                                           !! 2 = Hindcast/proj (100y cycle)
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&namcfcdia     !   additional 2D/3D tracers diagnostics 
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+!              !    name   !           title of the field          !     units      !
+!              !           !                                       !                !
+   cfcdia2d(1)  = 'qtr_c11 ' , 'Air-sea flux of CFC-11           ',  'mol/m2/s    '
+   cfcdia2d(2)  = 'qint_c11' , 'Cumulative air-sea flux of CFC-11 ', 'mol/m2      '
+/
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/namelist_idtra_ref
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/namelist_idtra_ref	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/namelist_idtra_ref	(revision 8201)
@@ -0,0 +1,43 @@
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+! idealize Tracer namelist :  NEMO idealize traceur model option and parameter input
+! -------------
+! 
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+!       namidtra   parameter for 1/2 decay time
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+!
+!! idealize tracer 1/2 decay time
+!!       tmp_decay   :  1/2 decay time
+!!
+!! idealize tracer names (to be added if needed)
+!!
+&namidtra
+!
+!! idealize tracer 1/2 decay time
+      tmp_decay = 10        !! years
+!! idealize tracer names
+!!###############################################
+!!   names are defined in the top namelist (namtrc) 
+!!   
+!!###############################################
+/
+!=================================================
+! nammeddia    Passive tracers additional diagnostics
+!=================================================
+!
+!      ctrc2d  : 2d output field name
+!      ctrc2u  : 2d output field unit
+!      ctrc2l  : 2d output field long name
+!
+!      nwriteadd: frequency of additional arrays outputs(namelist)
+!&nammeddia
+!!##########################################################
+!! No aditional diagnostics associated to idealize tracers.
+!! If one want to add additional diag, 
+!! can be done here, following the example just below 
+!!##########################################################
+!            meddia2d(1)  = 'INVTN'             ,              'Column N inventory'                            ,              'mmolN/m2'
+!            meddia2d(2)  = 'INVTSI'            ,              'Column Si inventory'                           ,              'mmolSi/m2'
+!/
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/namelist_medusa_ref
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/namelist_medusa_ref	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/namelist_medusa_ref	(revision 8201)
@@ -0,0 +1,372 @@
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+! BIO namelist :  MEDUSA biological model option and parameter input
+! -------------
+!
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+!       natbio   Shared parameters for dynamics/advection/thermo
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+!
+!! Primary production and chl related quantities
+!!       xxi         :  conversion factor from gC to mmolN 
+!!       xaln        :  Chl-a specific initial slope of P-I curve for non-diatoms 
+!!       xald        :  Chl-a specific initial slope of P-I curve for diatoms
+!!       jphy        :  phytoplankton T-dependent growth switch
+!!       xvpn        :  maximum growth rate for non-diatoms
+!!       xvpd        :  maximum growth rate for diatoms
+!!       xthetam     :  maximum Chl to C ratio for non-diatoms      
+!!       xthetamd    :  maximum Chl to C ratio for diatoms
+!!
+!! Diatom silicon parameters
+!!       xsin0       :  minimum diatom Si:N ratio
+!!       xnsi0       :  minimum diatom N:Si ratio
+!!       xuif        :  hypothetical growth ratio at infinite Si:N ratio
+!!
+!! Nutrient limitation
+!!       jliebig     :  Liebig nutrient uptake switch
+!!       xnln        :  half-sat constant for DIN uptake by non-diatoms 
+!!       xnld        :  half-sat constant for DIN uptake by diatoms 
+!!       xsl         :  half-sat constant for Si uptake by diatoms 
+!!       xfld        :  half-sat constant for Fe uptake by diatoms  
+!!       xfln        :  half-sat constant for Fe uptake by non-datoms 
+!!
+!! Grazing
+!!       xgmi        :  microzoo maximum growth rate 
+!!       xgme        :  mesozoo maximum growth rate 
+!!       xkmi        :  microzoo grazing half-sat parameter
+!!       xkme        :  mesozoo grazing half-sat parameter
+!!       xphi        :  micro/mesozoo grazing inefficiency
+!!       xbetan      :  micro/mesozoo N assimilation efficiency
+!!       xbetac      :  micro/mesozoo C assimilation efficiency
+!!       xkc         :  micro/mesozoo net C growth efficiency
+!!       xpmipn      :  grazing preference of microzoo for non-diatoms
+!!       xpmid       :  grazing preference of microzoo for diatoms
+!!       xpmepn      :  grazing preference of mesozoo for non-diatoms 
+!!       xpmepd      :  grazing preference of mesozoo for diatoms
+!!       xpmezmi     :  grazing preference of mesozoo for microzoo
+!!       xpmed       :  grazing preference of mesozoo for detritus
+!!
+!! Metabolic losses
+!!       xmetapn     :  non-diatom metabolic loss rate
+!!       xmetapd     :  diatom     metabolic loss rate
+!!       xmetazmi    :  microzoo   metabolic loss rate
+!!       xmetazme    :  mesozoo    metabolic loss rate
+!!
+!! Mortality losses
+!!       jmpn        :  non-diatom mortality functional form
+!!       xmpn        :  non-diatom mortality rate
+!!       xkphn       :  non-diatom mortality half-sat constant
+!!       jmpd        :  diatom     mortality functional form
+!!       xmpd        :  diatom     mortality rate
+!!       xkphd       :  diatom     mortality half-sat constant
+!!       jmzmi       :  microzoo   mortality functional form
+!!       xmzmi       :  microzoo   mortality rate
+!!       xkzmi       :  microzoo   mortality half-sat constant
+!!       jmzme       :  mesozoo    mortality functional form
+!!       xmzme       :  mesozoo    mortality rate
+!!       xkzme       :  mesozoo    mortality half-sat constant
+!!
+!! Remineralisation
+!!       jmd         :  detritus T-dependent remineralisation switch
+!!       jsfd        :  accelerate seafloor detritus remin. switch
+!!       xmd         :  detrital nitrogen remineralisation rate 
+!!       xmdc        :  detrital carbon   remineralisation rate 
+!!
+!! Stochiometric ratios
+!!       xthetapn    :  non-diatom C:N ratio
+!!       xthetapd    :  diatom C:N ratio
+!!       xthetazmi   :  microzoo C:N ratio
+!!       xthetazme   :  mesozoo C:N ratio
+!!       xthetad     :  detritus C:N ratio (FOR IMPLICIT DTC ONLY)
+!!       xrfn        :  phytoplankton Fe:N ratio
+!!	 xrsn        :  phytoplankton Si:N ratio (LEGACY; NOT USED)
+!!
+!! Iron parameters
+!!       jiron       :  iron scavenging submodel switch
+!!       xfe_mass    :  iron atomic mass
+!!	 xfe_sol     :  aeolian iron solubility
+!!	 xfe_sed     :  sediment iron input
+!!	 xLgT	     :  total ligand concentration (umol/m3)
+!!	 xk_FeL	     :  dissociation constant for (Fe + L)
+!!	 xk_sc_Fe    :  scavenging rate of "free" iron
+!!	 
+!! Fast-sinking detritus parameters
+!!       jmartin     :  fast detritus remineralisation switch
+!!       jfdfate     :  fate of fast detritus at seafloor switch
+!!       jrratio     :  rain ratio switch
+!!	 jocalccd    :  CCD switch
+!!	 xridg_r0    :  Ridgwell rain ratio coefficient
+!!       xfdfrac1    :  fast-sinking fraction of diatom nat. mort. losses
+!!       xfdfrac2    :  fast-sinking fraction of mesozooplankton mort. losses
+!!       xfdfrac3    :  fast-sinking fraction of diatom silicon grazing losses
+!!       xcaco3a     :  polar (high latitude) CaCO3 fraction
+!!       xcaco3b     :  equatorial (low latitude) CaCO3 fraction
+!!       xmassc      :  organic C mass:mole ratio, C106 H175 O40 N16 P1
+!!       xmassca     :  calcium carbonate mass:mole ratio, CaCO3
+!!       xmasssi     :  biogenic silicon mass:mole ratio, (H2SiO3)n
+!!       xprotca     :  calcium carbonate protection ratio
+!!       xprotsi     :  biogenic silicon protection ratio
+!!       xfastc      :  organic C remineralisation length scale
+!!       xfastca     :  calcium carbonate dissolution length scale
+!!       xfastsi     :  biogenic silicon dissolution length scale
+!!
+!! Benthos parameters
+!!       jorgben     :  does   organic detritus go to the benthos?
+!!       jinorgben   :  does inorganic detritus go to the benthos?
+!!       xsedn       :  organic   nitrogen sediment remineralisation rate 
+!!       xsedfe      :  organic   iron     sediment remineralisation rate 
+!!       xsedsi      :  inorganic silicon  sediment dissolution      rate 
+!!       xsedc       :  organic   carbon   sediment remineralisation rate 
+!!       xsedca      :  inorganic carbon   sediment dissolution      rate 
+!!       xburial     :  burial fraction of sediment material
+!!
+!! River parameters
+!!       jriver_n    :  riverine N          input?
+!!       jriver_si   :  riverine Si         input?
+!!       jriver_c    :  riverine C          input?
+!!       jriver_alk  :  riverine alkalinity input?
+!!       jriver_dep  :  depth of riverine   input?
+!!
+!! Miscellaneous
+!!       xsdiss      :  diatom frustule dissolution rate
+!!
+!! Gravitational sinking      
+!!       vsed        :  detritus gravitational sinking rate 
+!!       xhr         :  coeff for Martin's remineralisation profile
+!!
+!! Additional parameters
+!!       jpkb        :  vertical layer for diagnostic of the vertical flux 
+!!
+!! UKESM1 - new diagnostics  !! Jpalm
+!!       jdms        :  include dms diagnostics
+!!       jdms_input  :  use instant (0) or diel-avg (1) inputs
+!!       jdms_model  :  which DMS model is passed to atmosphere
+!!
+!!       
+&natbio
+!
+!! Primary production and chl related quantities
+      xxi       = 0.01257   !!
+      xaln      = 15.0      !! EKP (05/03/09)
+      xald      = 11.25     !! EKP (05/03/09)
+      jphy      = 1         !! 0 = T-independent; 1 = T-dependent; 2 = T-dependent-Q10
+      xvpn      = 0.640     !! EKP (05/03/09) -- daily avg = 0.530; daily cycle = 1.060; Q10 = 0.64
+      xvpd      = 0.600     !! EKP (05/03/09) -- daily avg = 0.500; daily cycle = 1.000; Q10 = 0.6
+      xthetam   = 0.05      !! EKP (05/03/09)
+      xthetamd  = 0.05      !! EKP (05/03/09)
+      jq10      = 1.50      !! Jpalm (17-06-2016)
+!!
+!! Diatom silicon parameters
+      xsin0     = 0.2       !! Mongin et al. (2003)
+      xnsi0     = 0.2       !! Mongin et al. (2003)
+      xuif      = 1.5       !! Mongin et al. (2003)
+!!
+!! Nutrient limitation
+      jliebig   = 0         !! 0 = multiplicative, 1 = Liebig
+      xnln      = 0.5       !! Fasham (1993)
+      xnld      = 0.75      !! EKP (05/03/09)
+      xsld      = 3.00      !! Fasham et al. (2006)-ish
+      xfln      = 0.00033   !! EKP (29/10/09); Parekh et al. (2005)
+      xfld      = 0.00067   !! EKP (29/10/09); Parekh et al. (2005); filtered through Moore et al. (2004)
+!!
+!! Grazing
+      xgmi      = 2.0       !! EKP (05/03/09)
+      xgme      = 0.5       !! AXY (21/12/09)
+      xkmi      = 0.8       !! EKP (26/02/09)
+      xkme      = 0.3       !! EKP (26/02/09)
+      xphi      = 0.20      !! Anderson & Pondaven (2003; 0.23); EKP (05/03/09; 0.20)
+      xbetan    = 0.77      !! Anderson & Pondaven (2003)
+      xbetac    = 0.64      !! Anderson & Pondaven (2003)
+!!    xbetan    = 0.69      !! compromise values inbetween those from ...
+!!    xbetac    = 0.69      !! Anderson & Pondaven (2003)for detrital carbon model
+      xkc       = 0.80      !! Anderson & Pondaven (2003)
+      xpmipn    = 0.75      !! 
+      xpmid     = 0.25      !!
+      xpmepn    = 0.15      !! EKP (26/02/09)
+      xpmepd    = 0.35      !! EKP (26/02/09)
+      xpmezmi   = 0.35      !! EKP (26/02/09)
+      xpmed     = 0.15      !! EKP (26/02/09)
+!!
+!! Metabolic losses
+      xmetapn   = 0.02      !! 
+      xmetapd   = 0.02      !! 
+      xmetazmi  = 0.02      !! 
+      xmetazme  = 0.02      !! 
+!!
+!! Mortality losses
+      jmpn      = 3         !! 1=linear; 2=quadratic; 3=hyperbolic; 4=sigmoid
+      xmpn      = 0.1       !!
+      xkphn     = 0.5       !! EKP (26/02/09): new parameter
+      jmpd      = 3         !! 1=linear; 2=quadratic; 3=hyperbolic; 4=sigmoid
+      xmpd      = 0.1       !!
+      xkphd     = 0.5       !! EKP (26/02/09): new parameter
+      jmzmi     = 3         !! 1=linear; 2=quadratic; 3=hyperbolic; 4=sigmoid
+      xmzmi     = 0.1       !!
+      xkzmi     = 0.5       !!
+      jmzme     = 3         !! 1=linear; 2=quadratic; 3=hyperbolic; 4=sigmoid
+      xmzme     = 0.2       !! EKP (26/02/09)
+      xkzme     = 0.75      !! EKP (26/02/09)
+!!
+!! Remineralisation
+      jmd       = 2         !! 0 = T-independent; 1 = T-dependent; 2 = T-dependent-Q10
+      jsfd      = 0         !! 0 = unchanged seafloor remin.; 1 = accelerated seafloor remin.
+      xmd       = 0.0190    !! T-dependent; 0.05 at 18C (Yool et al., 2010) - Q10 = 0.0190
+      xmdc      = 0.0152    !! T-dependent; 0.04 at 18C (Yool et al., 2010) - Q10 = 0.0152
+!! 
+!! Stochiometric ratios
+      xthetapn  = 6.625     !! Redfield
+      xthetapd  = 6.625     !! Redfield
+      xthetazmi = 5.625     !! Redfield
+      xthetazme = 5.625     !! Redfield
+!! AXY (26/11/08): implicit detrital carbon change
+      xthetad   = 6.625     !! Redfield
+      xrfn      = 30.0e-6   !! Parekh et al. (2005)
+      xrsn      = 1.0       !! not used here; retained for Lobster
+!!
+!! Iron parameters
+      jiron     = 1         !! iron scavenging submodel switch
+      xfe_mass  = 55.485    !! Fe atomic mass
+      xfe_sol   = 0.00532   !! scaled to get same input as Parekh et al. (2005)
+      xfe_sed   = 0.000228  !! AXY (10/07/12): Moore-ish
+      xLgT      = 1.0       !! from Diat-HadOCC; from Parekh et al. (2005)
+      xk_FeL	= 100.0     !! from Diat-HadOCC
+      xk_sc_Fe  = 1.e-3     !! from Dutkiewicz et al. (2005)
+!!
+!! Fast-sinking detritus parameters
+      jexport   = 1         !! 1 = ballast; 2 = Martin (1987); 3 = Henson (2011)
+      jfdfate   = 0         !! 0 = instant remin.; 1 = transmogrify into slow detritus
+      jrratio   = 2         !! 0 = Dunne (2005); 1 = Ridgwell (2007) surface; 2 = Ridgwell (2007) 3D
+      jocalccd  = 1         !! 0 = default, fixed; 1 = calculated, dynamic
+      xridg_r0  = 0.026     !! = 0.044, Ridgwell et al. (2007); scaled to 60% from preliminary sims
+      xfdfrac1  = 0.333     !! control parameter; no "real" value (AXY; 12/03/09)
+      xfdfrac2  = 1.00      !! control parameter; no "real" value (AXY; 12/03/09)
+      xfdfrac3  = 0.80      !! control parameter; no "real" value (AXY; 12/03/09)
+      xcaco3a   = 0.02      !! Dunne et al. (2005); not an exact value
+      xcaco3b   = 0.10      !! Dunne et al. (2005); not an exact value
+!! AXY (06/01/09): after contacting Dunne, new values are used for masses ...
+!!    xmassc    = 22.1188   !!
+!!    xmassca   = 100.086   !! original values; replaced by Dunne suggestion
+!!    xmasssi   = 78.0988   !!
+      xmassc    = 12.011    !! C atomic mass
+      xmassca   = 100.086   !! CaCO3; based on atomic masses
+      xmasssi   = 60.084    !! SiO2; based on atomic masses
+      xprotca   = 0.070     !! Dunne et al. (2005)
+      xprotsi   = 0.026     !! Dunne et al. (2005)
+      xfastc    = 188.0     !! Dunne et al. (2005)
+      xfastca   = 3500.0    !! Dunne et al. (2005)
+      xfastsi   = 2000.0    !! Dunne et al. (2005)
+!!
+!! Benthos parameters
+      jorgben   = 1         !! 0 = no; 1 = yes
+      jinorgben = 1         !! 0 = no; 1 = yes
+      xsedn     = 0.05      !! default ERSEM-ish value
+      xsedfe    = 0.05      !! default ERSEM-ish value
+      xsedsi    = 0.01      !! default ERSEM-ish value
+      xsedc     = 0.05      !! default ERSEM-ish value
+      xsedca    = 0.01      !! default ERSEM-ish value
+      xburial   = 0.0       !! set to zero
+!! 
+!! River parameters
+      jriver_n  = 0         !! 0 = no; 1 = runoff-dependent fluxes; 2= fixed fluxes
+      jriver_si = 0         !! 0 = no; 1 = runoff-dependent fluxes; 2= fixed fluxes
+      jriver_c  = 0         !! 0 = no; 1 = runoff-dependent fluxes; 2= fixed fluxes
+      jriver_alk= 0         !! 0 = no; 1 = runoff-dependent fluxes; 2= fixed fluxes
+      jriver_dep= 5         !! depth to which river nutrients are added
+!!
+!! Miscellaneous
+      xsdiss    = 0.006     !! Mongin et al. (2003); 0.006 is an alternative
+!!
+!! Gravitational sinking
+      vsed      = 3.472e-5  !! EKP (05/03/09)
+!!
+!! Additional parameters
+      jpkb      = 16        !! 
+!!
+!! UKESM1 - new diagnostics !! Jpalm
+      jdms       = 1        !! include dms diagnostics
+      jdms_input = 1        !! use instant (0) or diel-avg (1) inputs
+      jdms_model = 3        !! choice of DMS model passed to atmosphere
+!!                             1 = ANDR, 2 = SIMO, 3 = ARAN, 4 = HALL
+!!
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+!       natroam
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+!
+!!       xthetaphy :  oxygen evolution/consumption by phytoplankton
+!!                    = (32 / 16) + (6.625 * (119 / 106)) = (2 + 7.4375) mol O2 / mol N
+!!       xthetazoo :  oxygen consumption by zooplankton
+!!                    = (32 / 16) + (5.625 * (119 / 106)) = (2 + 6.3149) mol O2 / mol N
+!!       xthetanit :  oxygen consumption by nitrogen remineralisation
+!!                    = (32 / 16) = 2 mol O2 / mol N
+!!       xthetarem :  oxygen consumption by carbon remineralisation
+!!                    = (119 / 106) = 1.1226 mol O2 / mol C
+!!       xo2min    :  oxygen minimum concentration
+!
+&natroam
+   xthetaphy = 9.4375
+   xthetazoo = 8.3149
+   xthetanit = 2.0
+   xthetarem = 1.1226
+   xo2min    = 4.0
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+!       natopt
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+!
+!   xkg0 : green water absorption coefficient   [m-1]
+!   xkr0 : red water absorption coefficient     [m-1]
+!  xkgp  : pigment green absorption coefficient [m-1]
+!  xkrp  : pigment red absorption coefficient   [m-1]
+!  xlg   : green chl exposant
+!  xlr   : red chl exposant
+!  rpig  : chla / (chla+phea) ratio
+!
+&natopt
+   xkg0 = 0.0232
+   xkr0 = 0.225
+   xkgp = 0.074
+   xkrp = 0.037
+   xlg  = 0.629
+   xlr  = 0.674
+   rpig = 0.7
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+!       natdbi used if key_trc_diabio is set
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+!
+!  ctrbio    : array of biological trend numbers
+!  ctrbil    : character string describing each biological trend
+!  ctrbiu    : array of unit numbers used for trend output
+!  nwritebio : frequency of biological model output [timesteps]
+!
+&natdbi
+   ctrbio    = "BIO_01", "BIO_02", "BIO_03", "BIO_04", "BIO_05", "BIO_06", "BIO_07", "BIO_08", "BIO_09", "BIO_10", "BIO_11", "BIO_12", "BIO_13", "BIO_14", "BIO_15", "BIO_16", "BIO_17", "BIO_18", "BIO_19", "BIO_20", "BIO_21", "BIO_22", "BIO_23", "BIO_24", "BIO_25", "BIO_26", "BIO_27", "BIO_28", "BIO_29", "BIO_30", "BIO_31", "BIO_32", "BIO_33", "BIO_34"
+   ctrbil    = "BIO_01", "BIO_02", "BIO_03", "BIO_04", "BIO_05", "BIO_06", "BIO_07", "BIO_08", "BIO_09", "BIO_10", "BIO_11", "BIO_12", "BIO_13", "BIO_14", "BIO_15", "BIO_16", "BIO_17", "BIO_18", "BIO_19", "BIO_20", "BIO_21", "BIO_22", "BIO_23", "BIO_24", "BIO_25", "BIO_26", "BIO_27", "BIO_28", "BIO_29", "BIO_30", "BIO_31", "BIO_32", "BIO_33", "BIO_34"
+   ctrbiu    = "m","m","m","m","m","m","m","m","m","m","m","m","m","m","m","m","m","m","m","m","m","m","m","m","m","m","m","m","m","m","m","m","m","m"
+   nwritebio = 10
+!/
+!&natopt
+/
+!=================================================
+! nammeddia    Passive tracers additional diagnostics
+!=================================================
+!
+!      ctrc2d  : 2d output field name
+!      ctrc2u  : 2d output field unit
+!      ctrc2l  : 2d output field long name
+!
+!      nwriteadd: frequency of additional arrays outputs(namelist)
+&nammeddia
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nammedsbc     !   parameters for inputs deposition
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+!              !  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_dust     = 'dust.orca'       ,     -1            , 'dust'        ,  .true.      , .true. , 'yearly'  , ''       , ''    , ''
+!
+   cn_dir      = './'      !  root directory for the location of the dynamical files
+   bdustfer    =  .true.   ! boolean for dust input from the atmosphere
+/
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/namelist_top_MEDUSA_et_al_cfg
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/namelist_top_MEDUSA_et_al_cfg	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/namelist_top_MEDUSA_et_al_cfg	(revision 8201)
@@ -0,0 +1,119 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/TOP1 :   - tracer run information                (namtrc_run)
+!!               - tracer definition                     (namtrc    )
+!!               - tracer data initialisation            (namtrc_dta)
+!!               - tracer advection                      (namtrc_adv)
+!!               - tracer lateral diffusion              (namtrc_ldf)
+!!               - tracer vertical physics               (namtrc_zdf)
+!!               - tracer newtonian damping              (namtrc_dmp)
+!!               - dynamical tracer trends               (namtrc_trd)
+!!               - tracer output diagonstics             (namtrc_dia)
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namtrc_run     !   run information
+!-----------------------------------------------------------------------
+   nn_dttrc      =  1        !  time step frequency for passive sn_tracers
+   nn_writetrc   =  640     !  time step frequency for sn_tracer outputs
+   ln_top_euler  = .false.    !  use Euler time-stepping for TOP
+   ln_rsttr      = .false.   !  start from a restart file (T) or not (F)
+   nn_rsttr      =   0       !  restart control = 0 initial time step is not compared to the restart file value
+                           !                  = 1 do not use the value in the restart file
+                           !                  = 2 calendar parameters read in the restart file
+   cn_trcrst_in  = "restart_trc"   !  suffix of pass. sn_tracer restart name (input)
+   cn_trcrst_indir = "."           !  directory from which to read input passive tracer restarts
+   cn_trcrst_out = "restart_trc"   !  suffix of pass. sn_tracer restart name (output)
+   cn_trcrst_outdir = "."          !  directory to which to write output passive tracer restarts
+/
+!-----------------------------------------------------------------------
+&namtrc     !   tracers definition
+!-----------------------------------------------------------------------
+   ln_trcdta     =  .false.  !  Initialisation from data input file (T) or not (F)
+   ln_trcdmp     =  .false.  !  add a damping termn (T) or not (F)
+   ln_trcdmp_clo =  .false.  !  damping term (T) or not (F) on closed seas
+/
+!-----------------------------------------------------------------------
+&namtrc_dta      !    Initialisation from data input file
+!-----------------------------------------------------------------------
+!
+   cn_dir        =  './'      !  root directory for the location of the data files
+/
+!-----------------------------------------------------------------------
+&namtrc_adv    !   advection scheme for passive tracer 
+!-----------------------------------------------------------------------
+   ln_trcadv_cen2    =  .false.  !  2nd order centered scheme   
+   ln_trcadv_tvd     =  .true.  !  TVD scheme
+   ln_trcadv_muscl   =  .false.   !  MUSCL scheme
+   ln_trcadv_muscl2  =  .false.  !  MUSCL2 scheme + cen2 at boundaries
+   ln_trcadv_ubs     =  .false.  !  UBS scheme
+   ln_trcadv_qck     =  .false.  !  QUICKEST scheme
+   ln_trcadv_msc_ups =  .false.  !  use upstream scheme within muscl
+/
+!-----------------------------------------------------------------------
+&namtrc_ldf    !   lateral diffusion scheme for passive tracer 
+!-----------------------------------------------------------------------
+!                               !  Type of the operator : 
+   ln_trcldf_lap    =  .true.   !     laplacian operator       
+   ln_trcldf_bilap  =  .false.  !     bilaplacian operator     
+                                !  Direction of action  :
+   ln_trcldf_level  =  .false.  !     iso-level                
+   ln_trcldf_hor    =  .false.  !     horizontal (geopotential)         (require "key_ldfslp" when ln_sco=T)
+   ln_trcldf_iso    =  .true.   !     iso-neutral                       (require "key_ldfslp")
+!                               !  Coefficient
+   rn_ahtrc_0       =  2000.    !  horizontal eddy diffusivity for tracers [m2/s]
+   rn_ahtrb_0       =     0.    !     background eddy diffusivity for ldf_iso [m2/s]
+/
+!-----------------------------------------------------------------------
+&namtrc_zdf        !   vertical physics
+!-----------------------------------------------------------------------
+   ln_trczdf_exp   =  .false.  !  split explicit (T) or implicit (F) time stepping
+   nn_trczdf_exp   =   3       !  number of sub-timestep for ln_trczdfexp=T
+/
+!-----------------------------------------------------------------------
+&namtrc_rad        !  treatment of negative concentrations 
+!-----------------------------------------------------------------------
+   ln_trcrad   =  .true.  !  artificially correct negative concentrations (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namtrc_dmp    !   passive tracer newtonian damping   
+!-----------------------------------------------------------------------
+   nn_zdmp_tr  =    1      !  vertical   shape =0    damping throughout the water column
+                           !                   =1 no damping in the mixing layer (kz  criteria)
+                           !                   =2 no damping in the mixed  layer (rho crieria)
+   cn_resto_tr  = 'resto_tr.nc'    !  create a damping.coeff NetCDF file (=1) or not (=0)
+/
+!-----------------------------------------------------------------------
+&namtrc_ice       !    Representation of sea ice growth & melt effects
+!-----------------------------------------------------------------------
+   nn_ice_tr   =  -1        !  tracer concentration in sea ice 
+                           !    =-1 (no vvl: identical cc in ice and ocean / vvl: cc_ice = 0)
+                           !    = 0 (no vvl: cc_ice = zero / vvl: cc_ice = )
+                           !    = 1 prescribed to a namelist value (implemented in pisces only)
+/
+!-----------------------------------------------------------------------
+&namtrc_trd       !   diagnostics on tracer trends        ('key_trdtrc')
+!                          or mixed-layer trends          ('key_trdmld_trc')
+!----------------------------------------------------------------------
+   nn_trd_trc  =  640       !  time step frequency and tracers trends
+   nn_ctls_trc =   0        !  control surface type in mixed-layer trends (0,1 or n<jpk)
+   rn_ucf_trc  =   1        !  unit conversion factor (=1 -> /seconds ; =86400. -> /day)
+   ln_trdmld_trc_restart = .false.  !  restart for ML diagnostics
+   ln_trdmld_trc_instant = .true.  !  flag to diagnose trends of instantantaneous or mean ML T/S
+   ln_trdtrc(1)  =   .true.
+   ln_trdtrc(2)  =   .true.
+   ln_trdtrc(23) =   .true.
+/
+!-----------------------------------------------------------------------
+&namtrc_dia       !   parameters for passive tracer additional diagnostics
+!----------------------------------------------------------------------
+   ln_diatrc     =  .false.  !  save additional diag. (T) or not (F)
+   ln_diabio     =  .true.   !  output biological trends
+   nn_writedia   =  640      !  time step frequency for diagnostics
+   nn_writebio   =  640      !: frequency of biological outputs
+/
+!----------------------------------------------------------------------
+! namtrc_bc       !   data for boundary conditions
+!-----------------------------------------------------------------------
+&namtrc_bc
+!
+   cn_dir        =  './'      !  root directory for the location of the data files
+/
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/namelist_top_MEDUSA_et_al_ref
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/namelist_top_MEDUSA_et_al_ref	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/SHARED/namelist_top_MEDUSA_et_al_ref	(revision 8201)
@@ -0,0 +1,119 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/TOP1 :   - tracer run information                (namtrc_run)
+!!               - tracer definition                     (namtrc    )
+!!               - tracer data initialisation            (namtrc_dta)
+!!               - tracer advection                      (namtrc_adv)
+!!               - tracer lateral diffusion              (namtrc_ldf)
+!!               - tracer vertical physics               (namtrc_zdf)
+!!               - tracer newtonian damping              (namtrc_dmp)
+!!               - dynamical tracer trends               (namtrc_trd)
+!!               - tracer output diagonstics             (namtrc_dia)
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namtrc_run     !   run information
+!-----------------------------------------------------------------------
+   nn_dttrc      =  1        !  time step frequency for passive sn_tracers
+   nn_writetrc   =  640     !  time step frequency for sn_tracer outputs
+   ln_top_euler  = .false.    !  use Euler time-stepping for TOP
+   ln_rsttr      = .false.   !  start from a restart file (T) or not (F)
+   nn_rsttr      =   0       !  restart control = 0 initial time step is not compared to the restart file value
+                           !                  = 1 do not use the value in the restart file
+                           !                  = 2 calendar parameters read in the restart file
+   cn_trcrst_in  = "restart_trc"   !  suffix of pass. sn_tracer restart name (input)
+   cn_trcrst_indir = "."           !  directory from which to read input passive tracer restarts
+   cn_trcrst_out = "restart_trc"   !  suffix of pass. sn_tracer restart name (output)
+   cn_trcrst_outdir = "."          !  directory to which to write output passive tracer restarts
+/
+!-----------------------------------------------------------------------
+&namtrc     !   tracers definition
+!-----------------------------------------------------------------------
+   ln_trcdta     =  .false.  !  Initialisation from data input file (T) or not (F)
+   ln_trcdmp     =  .false.  !  add a damping termn (T) or not (F)
+   ln_trcdmp_clo =  .false.  !  damping term (T) or not (F) on closed seas
+/
+!-----------------------------------------------------------------------
+&namtrc_dta      !    Initialisation from data input file
+!-----------------------------------------------------------------------
+!
+   cn_dir        =  './'      !  root directory for the location of the data files
+/
+!-----------------------------------------------------------------------
+&namtrc_adv    !   advection scheme for passive tracer 
+!-----------------------------------------------------------------------
+   ln_trcadv_cen2    =  .false.  !  2nd order centered scheme   
+   ln_trcadv_tvd     =  .true.  !  TVD scheme
+   ln_trcadv_muscl   =  .false.   !  MUSCL scheme
+   ln_trcadv_muscl2  =  .false.  !  MUSCL2 scheme + cen2 at boundaries
+   ln_trcadv_ubs     =  .false.  !  UBS scheme
+   ln_trcadv_qck     =  .false.  !  QUICKEST scheme
+   ln_trcadv_msc_ups =  .false.  !  use upstream scheme within muscl
+/
+!-----------------------------------------------------------------------
+&namtrc_ldf    !   lateral diffusion scheme for passive tracer 
+!-----------------------------------------------------------------------
+!                               !  Type of the operator : 
+   ln_trcldf_lap    =  .true.   !     laplacian operator       
+   ln_trcldf_bilap  =  .false.  !     bilaplacian operator     
+                                !  Direction of action  :
+   ln_trcldf_level  =  .false.  !     iso-level                
+   ln_trcldf_hor    =  .false.  !     horizontal (geopotential)         (require "key_ldfslp" when ln_sco=T)
+   ln_trcldf_iso    =  .true.   !     iso-neutral                       (require "key_ldfslp")
+!                               !  Coefficient
+   rn_ahtrc_0       =  2000.    !  horizontal eddy diffusivity for tracers [m2/s]
+   rn_ahtrb_0       =     0.    !     background eddy diffusivity for ldf_iso [m2/s]
+/
+!-----------------------------------------------------------------------
+&namtrc_zdf        !   vertical physics
+!-----------------------------------------------------------------------
+   ln_trczdf_exp   =  .false.  !  split explicit (T) or implicit (F) time stepping
+   nn_trczdf_exp   =   3       !  number of sub-timestep for ln_trczdfexp=T
+/
+!-----------------------------------------------------------------------
+&namtrc_rad        !  treatment of negative concentrations 
+!-----------------------------------------------------------------------
+   ln_trcrad   =  .true.  !  artificially correct negative concentrations (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namtrc_dmp    !   passive tracer newtonian damping   
+!-----------------------------------------------------------------------
+   nn_zdmp_tr  =    1      !  vertical   shape =0    damping throughout the water column
+                           !                   =1 no damping in the mixing layer (kz  criteria)
+                           !                   =2 no damping in the mixed  layer (rho crieria)
+   cn_resto_tr  = 'resto_tr.nc'    !  create a damping.coeff NetCDF file (=1) or not (=0)
+/
+!-----------------------------------------------------------------------
+&namtrc_ice       !    Representation of sea ice growth & melt effects
+!-----------------------------------------------------------------------
+   nn_ice_tr   =  -1        !  tracer concentration in sea ice 
+                           !    =-1 (no vvl: identical cc in ice and ocean / vvl: cc_ice = 0)
+                           !    = 0 (no vvl: cc_ice = zero / vvl: cc_ice = )
+                           !    = 1 prescribed to a namelist value (implemented in pisces only)
+/
+!-----------------------------------------------------------------------
+&namtrc_trd       !   diagnostics on tracer trends        ('key_trdtrc')
+!                          or mixed-layer trends          ('key_trdmld_trc')
+!----------------------------------------------------------------------
+   nn_trd_trc  =  640       !  time step frequency and tracers trends
+   nn_ctls_trc =   0        !  control surface type in mixed-layer trends (0,1 or n<jpk)
+   rn_ucf_trc  =   1        !  unit conversion factor (=1 -> /seconds ; =86400. -> /day)
+   ln_trdmld_trc_restart = .false.  !  restart for ML diagnostics
+   ln_trdmld_trc_instant = .true.  !  flag to diagnose trends of instantantaneous or mean ML T/S
+   ln_trdtrc(1)  =   .true.
+   ln_trdtrc(2)  =   .true.
+   ln_trdtrc(23) =   .true.
+/
+!-----------------------------------------------------------------------
+&namtrc_dia       !   parameters for passive tracer additional diagnostics
+!----------------------------------------------------------------------
+   ln_diatrc     =  .false.  !  save additional diag. (T) or not (F)
+   ln_diabio     =  .true.   !  output biological trends
+   nn_writedia   =  640      !  time step frequency for diagnostics
+   nn_writebio   =  640      !: frequency of biological outputs
+/
+!----------------------------------------------------------------------
+! namtrc_bc       !   data for boundary conditions
+!-----------------------------------------------------------------------
+&namtrc_bc
+!
+   cn_dir        =  './'      !  root directory for the location of the data files
+/
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/cfg.txt
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/cfg.txt	(revision 8200)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/CONFIG/cfg.txt	(revision 8201)
@@ -11,2 +11,3 @@
 GYRE OPA_SRC
 ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC
+ORCA2_OFF_MEDUSA OPA_SRC OFF_SRC TOP_SRC
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F	(revision 8201)
@@ -0,0 +1,1175 @@
+!
+! $Id: modarrays.F 2715 2011-03-30 15:58:35Z rblod $
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_Arrays
+C      
+      Module Agrif_Arrays
+      Use Agrif_Types
+C
+      implicit none
+C      
+      Contains
+C     **************************************************************************
+CCC   Subroutine Agrif_Childbounds
+C     **************************************************************************
+C
+      Subroutine Agrif_Childbounds(nbdim,lboundloc,uboundloc,
+     &                 pttab,petab,pttruetab,cetruetab,memberin)
+C
+CCC   Description:
+CCC   Subroutine calculating the global indices of the child grid
+C
+C
+C     Declarations:
+C
+
+C
+C     Arguments
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim) :: lboundloc,uboundloc
+      INTEGER,DIMENSION(nbdim) :: pttab,petab,pttruetab,cetruetab
+      LOGICAL :: memberin
+C
+C     Local variables
+      INTEGER :: i,lbglob,ubglob
+C
+#ifdef key_mpp_mpi
+      INTEGER :: indglob1,indglob2
+#endif
+C
+C
+      do i = 1,nbdim
+C
+        lbglob = lboundloc(i)
+        ubglob = uboundloc(i)
+C
+#ifdef key_mpp_mpi
+C
+        Call AGRIF_InvLoc(lbglob,Agrif_ProcRank,i,indglob1)
+C
+        Call AGRIF_InvLoc(ubglob,Agrif_ProcRank,i,indglob2)
+C
+        pttruetab(i) = max(pttab(i),indglob1)        
+C
+        cetruetab(i) = min(petab(i),indglob2)                 
+C
+#else
+C
+        pttruetab(i) = max(pttab(i),lbglob)        
+C
+        cetruetab(i) = min(petab(i),ubglob)
+C
+#endif
+C
+      enddo
+
+      memberin = .TRUE.
+
+      do i=1,nbdim
+        IF (cetruetab(i) < pttruetab(i)) THEN
+          memberin = .FALSE.
+          EXIT
+        ENDIF
+      enddo
+C
+      Return
+C
+C
+      End Subroutine Agrif_Childbounds
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_nbdim_Get_bound
+C     **************************************************************************
+C
+      Subroutine Agrif_nbdim_Get_bound(Variable,
+     &                           lower,upper,indice,nbdim)
+C
+CCC   Description:
+CCC   This subroutine is used to get the lower and the upper boundaries of a
+C     table. Output datas are scalar.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+C
+      ! we want extract boundaries of this table
+      TYPE(AGRIF_Variable), Pointer :: Variable    
+      INTEGER              :: lower,upper ! output data
+      ! direction in wich we want to know the dimension
+      INTEGER              :: indice      
+      INTEGER              :: nbdim       ! dimension of the table
+C
+C     Local variables
+C
+
+      lower = Variable % lb(indice)
+      upper = Variable % ub(indice)
+      return
+C
+      End Subroutine Agrif_nbdim_Get_bound       
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Get_bound_dimension
+C     **************************************************************************
+C
+      Subroutine Agrif_nbdim_Get_bound_dimension(Variable,
+     &                              lower,upper,nbdim)
+C
+CCC   Description:
+CCC   This subroutine is used to get the lower and the upper boundaries of a
+C        table. Output datas are scalar.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+C
+      ! we want extract boundaries of this table
+      TYPE(AGRIF_Variable), Pointer     :: Variable    
+      INTEGER                  :: nbdim       ! dimension of the table
+      INTEGER,DIMENSION(nbdim) :: lower,upper ! output data
+C
+C     Local variables       
+C
+      lower = Variable % lb(1:nbdim)
+      upper = Variable % ub(1:nbdim)
+      return
+C
+      End Subroutine Agrif_nbdim_Get_bound_dimension     
+      
+C     **************************************************************************
+CCC   Subroutine Agrif_nbdim_allocation
+C     **************************************************************************
+C
+      Subroutine Agrif_nbdim_allocation(Variable,inf,sup,nbdim)
+C
+CCC   Description:
+CCC   This subroutine is used to Allocate the table Variable
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+C
+      TYPE(AGRIF_Variable), Pointer     :: Variable    
+      INTEGER                  :: nbdim       ! dimension of the table
+      INTEGER,DIMENSION(nbdim) :: inf,sup
+C
+C     Local variables       
+C
+      SELECT CASE (nbdim)
+      CASE (1)
+         allocate(Variable%array1(
+     &            inf(1):sup(1)))
+      CASE (2)
+          allocate(Variable%array2(
+     &            inf(1):sup(1),
+     &            inf(2):sup(2)))
+      CASE (3)
+         allocate(Variable%array3(
+     &            inf(1):sup(1),
+     &            inf(2):sup(2),
+     &            inf(3):sup(3)))
+      CASE (4)
+         allocate(Variable%array4(
+     &            inf(1):sup(1),
+     &            inf(2):sup(2),
+     &            inf(3):sup(3),
+     &            inf(4):sup(4)))
+      CASE (5)
+         allocate(Variable%array5(
+     &            inf(1):sup(1),
+     &            inf(2):sup(2),
+     &            inf(3):sup(3),
+     &            inf(4):sup(4),
+     &            inf(5):sup(5)))
+      CASE (6)
+         allocate(Variable%array6(
+     &            inf(1):sup(1),
+     &            inf(2):sup(2),
+     &            inf(3):sup(3),
+     &            inf(4):sup(4),
+     &            inf(5):sup(5),
+     &            inf(6):sup(6)))
+      END SELECT
+C
+      return
+C
+      End Subroutine Agrif_nbdim_allocation
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_nbdim_deallocation
+C     **************************************************************************
+C
+      Subroutine Agrif_nbdim_deallocation(Variable,nbdim)
+C
+CCC   Description:
+CCC   This subroutine is used to give the same value to the table Variable
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+C
+      TYPE(AGRIF_Variable), Pointer     :: Variable    
+      INTEGER                  :: nbdim       ! dimension of the table
+C
+C     Local variables       
+C
+
+      SELECT CASE (nbdim)
+      CASE (1)
+         Deallocate(Variable%array1)
+      CASE (2)
+         Deallocate(Variable%array2)
+      CASE (3)
+         Deallocate(Variable%array3)
+      CASE (4)
+         Deallocate(Variable%array4)
+      CASE (5)
+         Deallocate(Variable%array5)
+      CASE (6)
+         Deallocate(Variable%array6)
+      END SELECT
+C
+      return
+C
+      End Subroutine Agrif_nbdim_deallocation
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_nbdim_Full_VarEQreal
+C     **************************************************************************
+C
+      Subroutine Agrif_nbdim_Full_VarEQreal(Variable,Value,nbdim)
+C
+CCC   Description:
+CCC   This subroutine is used to get the lower and the upper boundaries of a
+C        table. Output datas are scalar.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+C
+      TYPE(AGRIF_Variable), Pointer :: Variable    
+      REAL                 :: Value       
+      INTEGER              :: nbdim       ! dimension of the table
+C
+C     Local variables       
+C
+      SELECT CASE (nbdim)
+      CASE (1)
+        Variable%array1 = Value      
+      CASE (2)
+        Variable%array2 = Value
+      CASE (3)
+        Call Agrif_set_tozero3D(Variable%array3)
+!        Variable%array3 = Value
+      CASE (4)
+        Variable%array4 = Value
+      CASE (5)
+        Variable%array5 = Value
+      CASE (6)
+        Variable%array6 = Value
+      END SELECT
+C
+      return
+C
+      End Subroutine Agrif_nbdim_Full_VarEQreal   
+      
+      Subroutine Agrif_set_tozero3D(tab3D)
+      real,dimension(:,:,:),target :: tab3D
+      
+      tab3D = 0.
+      
+      end subroutine agrif_set_tozero3D    
+C
+C
+#if !defined key_mpp_mpi
+C     **************************************************************************
+CCC   Subroutine Agrif_nbdim_VarEQreal
+C     **************************************************************************
+C
+      Subroutine Agrif_nbdim_VarEQreal(Variable,inf,sup,Value,nbdim)
+C
+CCC   Description:
+CCC   This subroutine is used to give the same value to a part of 
+C        the table Variable
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+C
+      TYPE(AGRIF_Variable), Pointer :: Variable    
+      REAL                 :: Value       
+      INTEGER              :: nbdim       ! dimension of the table
+      INTEGER,DIMENSION(nbdim) :: inf,sup
+C
+C     Local variables       
+C
+      SELECT CASE (nbdim)
+      CASE (1)
+         Variable%array1(
+     &             inf(1):sup(1)
+     &             )  = Value
+      CASE (2)
+         Variable%array2(
+     &             inf(1):sup(1),
+     &             inf(2):sup(2)
+     &             )  = Value
+      CASE (3)
+         Variable%array3(
+     &             inf(1):sup(1),
+     &             inf(2):sup(2),
+     &             inf(3):sup(3)
+     &             )  = Value
+      CASE (4)
+         Variable%array4(
+     &             inf(1):sup(1),
+     &             inf(2):sup(2),
+     &             inf(3):sup(3),
+     &             inf(4):sup(4)
+     &             )  = Value
+      CASE (5)
+         Variable%array5(
+     &             inf(1):sup(1),
+     &             inf(2):sup(2),
+     &             inf(3):sup(3),
+     &             inf(4):sup(4),
+     &             inf(5):sup(5)
+     &             )  = Value
+      CASE (6)
+         Variable%array6(
+     &             inf(1):sup(1),
+     &             inf(2):sup(2),
+     &             inf(3):sup(3),
+     &             inf(4):sup(4),
+     &             inf(5):sup(5),
+     &             inf(6):sup(6)
+     &             )  = Value
+      END SELECT
+C
+      return
+C
+      End Subroutine Agrif_nbdim_VarEQreal       
+#endif
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_nbdim_VarEQvar
+C     **************************************************************************
+C
+      Subroutine Agrif_nbdim_VarEQvar(Variable,inf,sup,
+     &                                Variable2,inf2,sup2,
+     &                                nbdim)
+C
+CCC   Description:
+CCC   This subroutine is used to give the value of a part of the table 
+C        Variable2 to the table Variable
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+C
+      TYPE(AGRIF_Variable), Pointer     :: Variable
+      TYPE(AGRIF_Variable), Pointer     :: Variable2
+      INTEGER                  :: nbdim       ! dimension of the table
+      INTEGER,DIMENSION(nbdim) :: inf,sup
+      INTEGER,DIMENSION(nbdim) :: inf2,sup2
+C
+C     Local variables       
+C
+      SELECT CASE (nbdim)
+      CASE (1)
+         Variable%array1(inf(1):sup(1)) = 
+     &         Variable2%array1(inf2(1):sup2(1))
+      CASE (2)
+     
+      Call Agrif_Copy_2d(Variable%array2,Variable2%array2,
+     &  lbound(Variable%array2),
+     &  lbound(Variable2%array2),
+     &  inf,sup,inf2,sup2)
+          
+      CASE (3)
+
+      Call Agrif_Copy_3d(Variable%array3,Variable2%array3,
+     &  lbound(Variable%array3),
+     &  lbound(Variable2%array3),
+     &  inf,sup,inf2,sup2)
+
+      CASE (4)
+      
+      Call Agrif_Copy_4d(Variable%array4,Variable2%array4,
+     &  lbound(Variable%array4),
+     &  lbound(Variable2%array4),
+     &  inf,sup,inf2,sup2)
+     
+      CASE (5)
+        Variable%array5(inf(1):sup(1),
+     &                         inf(2):sup(2), 
+     &                         inf(3):sup(3),
+     &                         inf(4):sup(4), 
+     &                         inf(5):sup(5)) = 
+     &         Variable2%array5(inf2(1):sup2(1),
+     &                          inf2(2):sup2(2),
+     &                          inf2(3):sup2(3),
+     &                          inf2(4):sup2(4),
+     &                          inf2(5):sup2(5))
+      CASE (6)
+        Variable%array6(inf(1):sup(1),
+     &                         inf(2):sup(2),
+     &                         inf(3):sup(3),
+     &                         inf(4):sup(4),
+     &                         inf(5):sup(5),
+     &                         inf(6):sup(6)) = 
+     &         Variable2%array6(inf2(1):sup2(1),
+     &                          inf2(2):sup2(2),
+     &                          inf2(3):sup2(3),
+     &                          inf2(4):sup2(4),
+     &                          inf2(5):sup2(5),
+     &                          inf2(6):sup2(6))
+      END SELECT
+C
+      return
+C
+      End Subroutine Agrif_nbdim_VarEQvar
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_nbdim_Full_VarEQvar
+C     **************************************************************************
+C
+      Subroutine Agrif_nbdim_Full_VarEQvar(Variable,Variable2,
+     &                                nbdim)
+C
+CCC   Description:
+CCC   This subroutine is used to give the value of the table Variable2 
+C        to the table Variable
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+C
+      TYPE(AGRIF_Variable), Pointer     :: Variable
+      TYPE(AGRIF_Variable), Pointer     :: Variable2
+      INTEGER                  :: nbdim       ! dimension of the table
+C
+C     Local variables       
+C
+      SELECT CASE (nbdim)
+      CASE (1)
+          Variable%array1 = Variable2%array1
+      CASE (2)
+          Variable%array2 = Variable2%array2
+      CASE (3)
+          Variable%array3 = Variable2%array3
+      CASE (4)
+          Variable%array4 = Variable2%array4
+      CASE (5)
+          Variable%array5 = Variable2%array5
+      CASE (6)
+          Variable%array6 = Variable2%array6
+      END SELECT
+C
+      return
+C
+      End Subroutine Agrif_nbdim_Full_VarEQvar
+C
+C
+
+C     **************************************************************************
+CCC   Subroutine GiveAgrif_SpecialValueToTab_mpi
+C     **************************************************************************
+C
+      Subroutine GiveAgrif_SpecialValueToTab_mpi(Variable1,Variable2,
+     &                  bound1,lower,upper,Value,nbdim)
+C
+CCC   Description:
+CCC   
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+C
+      TYPE(AGRIF_VARIABLE), Pointer    :: Variable1
+      TYPE(AGRIF_VARIABLE), Pointer    :: Variable2
+      INTEGER                  :: nbdim
+      INTEGER,DIMENSION(:,:,:) :: bound1
+      INTEGER,DIMENSION(nbdim) :: lower,upper
+      REAL                     :: Value
+C
+C     Local variables       
+C
+      SELECT CASE (nbdim)
+      CASE (1)
+             Where (Variable1 % array1(
+     &           bound1(1,1,2):bound1(1,2,2)) 
+     &            == Value)
+             Variable2 % array1(bound1(1,1,1):bound1(1,2,1))
+     &                        = Value
+C      
+              End Where
+      CASE (2)
+             Where (Variable1 % array2(
+     &           bound1(1,1,2):bound1(1,2,2),
+     &           bound1(2,1,2):bound1(2,2,2)) 
+     &            == Value)
+             Variable2 % array2(bound1(1,1,1):bound1(1,2,1),
+     &                       bound1(2,1,1):bound1(2,2,1))
+     &                        = Value
+C      
+              End Where
+      CASE (3)
+             Where (Variable1 % array3(
+     &           bound1(1,1,2):bound1(1,2,2),
+     &                       bound1(2,1,2):bound1(2,2,2),
+     &                       bound1(3,1,2):bound1(3,2,2)) 
+     &            == Value)
+             Variable2 % array3(bound1(1,1,1):bound1(1,2,1),
+     &                       bound1(2,1,1):bound1(2,2,1),
+     &                       bound1(3,1,1):bound1(3,2,1))
+     &                         = Value
+C      
+              End Where
+      CASE (4)
+             Where (Variable1 % array4(
+     &           bound1(1,1,2):bound1(1,2,2),
+     &                       bound1(2,1,2):bound1(2,2,2),
+     &                       bound1(3,1,2):bound1(3,2,2),
+     &                       bound1(4,1,2):bound1(4,2,2)) 
+     &            == Value)
+             Variable2 % array4(bound1(1,1,1):bound1(1,2,1),
+     &                       bound1(2,1,1):bound1(2,2,1),
+     &                       bound1(3,1,1):bound1(3,2,1),
+     &                       bound1(4,1,1):bound1(4,2,1))
+     &                        = Value
+C      
+              End Where
+      CASE (5)
+             Where (Variable1 % array5(
+     &           bound1(1,1,2):bound1(1,2,2),
+     &                       bound1(2,1,2):bound1(2,2,2),
+     &                       bound1(3,1,2):bound1(3,2,2),
+     &                       bound1(4,1,2):bound1(4,2,2),
+     &                       bound1(5,1,2):bound1(5,2,2)) 
+     &            == Value)
+             Variable2 % array5(bound1(1,1,1):bound1(1,2,1),
+     &                       bound1(2,1,1):bound1(2,2,1),
+     &                       bound1(3,1,1):bound1(3,2,1),
+     &                       bound1(4,1,1):bound1(4,2,1),
+     &                       bound1(5,1,1):bound1(5,2,1))
+     &                        = Value
+C      
+              End Where
+      CASE (6)
+             Where (Variable1 % array6(
+     &           bound1(1,1,2):bound1(1,2,2),
+     &                       bound1(2,1,2):bound1(2,2,2),
+     &                       bound1(3,1,2):bound1(3,2,2),
+     &                       bound1(4,1,2):bound1(4,2,2),
+     &                       bound1(5,1,2):bound1(5,2,2),
+     &                       bound1(6,1,2):bound1(6,2,2)) 
+     &            == Value)
+             Variable2 % array6(bound1(1,1,1):bound1(1,2,1),
+     &                       bound1(2,1,1):bound1(2,2,1),
+     &                       bound1(3,1,1):bound1(3,2,1),
+     &                       bound1(4,1,1):bound1(4,2,1),
+     &                       bound1(5,1,1):bound1(5,2,1),
+     &                       bound1(6,1,1):bound1(6,2,1))
+     &                        = Value
+C      
+              End Where
+      END SELECT
+C
+      return
+C
+      End Subroutine GiveAgrif_SpecialValueToTab_mpi    
+
+C     **************************************************************************
+CCC   Subroutine GiveAgrif_SpecialValueToTab
+C     **************************************************************************
+C
+      Subroutine GiveAgrif_SpecialValueToTab(Variable1,Variable2,
+     &                  lower,upper,Value,nbdim)
+C
+CCC   Description:
+CCC   
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+C
+      TYPE(AGRIF_VARIABLE), Pointer    :: Variable1
+      TYPE(AGRIF_VARIABLE), Pointer    :: Variable2
+      INTEGER                  :: nbdim
+      INTEGER,DIMENSION(nbdim) :: lower,upper
+      REAL                     :: Value
+C
+C     Local variables       
+C
+      SELECT CASE (nbdim)
+      CASE (1)
+             Where (Variable1 % array1(
+     &           lower(1):upper(1))
+     &            == Value)
+             Variable2 % array1(lower(1):upper(1))
+     &                        = Value
+C      
+              End Where
+      CASE (2)
+             Where (Variable1 % array2(
+     &           lower(1):upper(1),
+     &           lower(2):upper(2)) 
+     &            == Value)
+             Variable2 % array2(lower(1):upper(1),
+     &                          lower(2):upper(2))
+     &                        = Value
+C      
+              End Where
+      CASE (3)
+             Where (Variable1 % array3(
+     &           lower(1):upper(1),
+     &           lower(2):upper(2), 
+     &           lower(3):upper(3)) 
+     &            == Value)
+             Variable2 % array3(lower(1):upper(1),
+     &                          lower(2):upper(2),
+     &                          lower(3):upper(3))
+     &                         = Value
+C      
+              End Where
+      CASE (4)
+             Where (Variable1 % array4(
+     &           lower(1):upper(1),
+     &           lower(2):upper(2), 
+     &           lower(3):upper(3),
+     &           lower(4):upper(4)) 
+     &            == Value)
+             Variable2 % array4(lower(1):upper(1),
+     &                          lower(2):upper(2),
+     &                          lower(3):upper(3),
+     &                          lower(4):upper(4))
+     &                        = Value
+C      
+              End Where
+      CASE (5)
+             Where (Variable1 % array5(
+     &           lower(1):upper(1),
+     &           lower(2):upper(2),
+     &           lower(3):upper(3),
+     &           lower(4):upper(4),
+     &           lower(5):upper(5)) 
+     &            == Value)
+             Variable2 % array5(lower(1):upper(1),
+     &                          lower(2):upper(2),
+     &                          lower(3):upper(3),
+     &                          lower(4):upper(4),
+     &                          lower(5):upper(5))
+     &                        = Value
+C      
+              End Where
+      CASE (6)
+             Where (Variable1 % array6(
+     &           lower(1):upper(1),
+     &           lower(2):upper(2),
+     &           lower(2):upper(3),
+     &           lower(4):upper(4),
+     &           lower(5):upper(5),
+     &           lower(6):upper(6)) 
+     &            == Value)
+             Variable2 % array6(lower(1):upper(1),
+     &                          lower(2):upper(2),
+     &                          lower(3):upper(3),
+     &                          lower(4):upper(4),
+     &                          lower(5):upper(5),
+     &                          lower(6):upper(6))
+     &                        = Value
+C      
+              End Where
+      END SELECT
+C
+      return
+C
+      End Subroutine GiveAgrif_SpecialValueToTab   
+
+C
+C
+#ifdef key_mpp_mpi
+C     **************************************************************************
+CCC   Subroutine Where_ValTabToTab_mpi
+C     **************************************************************************
+C
+      Subroutine Where_ValTabToTab_mpi(
+     &                  Variable1,Variable2,
+     &                  lower,upper,Value,nbdim)
+C
+CCC   Description:
+CCC   
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+C
+      TYPE(AGRIF_VARIABLE), Pointer     :: Variable1
+      TYPE(AGRIF_VARIABLE), Pointer     :: Variable2
+      INTEGER                  :: nbdim
+      INTEGER,DIMENSION(nbdim) :: lower,upper
+      REAL                     :: Value
+      INTEGER :: i,j,k,l,m,n
+C
+C     Local variables       
+C
+      SELECT CASE (nbdim)
+      CASE (1)
+            DO i = lower(1),upper(1)
+              IF (variable1%array1(i) == Value) then
+                variable1%array1(i)=Variable2%array1(i)
+              ENDIF
+            ENDDO
+      CASE (2)
+            DO j = lower(2),upper(2)
+            DO i = lower(1),upper(1)
+              IF (variable1%array2(i,j) == Value) then
+                variable1%array2(i,j)=Variable2%array2(i,j)
+              ENDIF
+            ENDDO
+            ENDDO
+      CASE (3)
+            DO k = lower(3),upper(3)
+            DO j = lower(2),upper(2)
+            DO i = lower(1),upper(1)
+              IF (variable1%array3(i,j,k) == Value) then
+                variable1%array3(i,j,k)=Variable2%array3(i,j,k)
+              ENDIF
+            ENDDO
+            ENDDO
+            ENDDO
+      CASE (4)
+            DO l = lower(4),upper(4)
+            DO k = lower(3),upper(3)
+            DO j = lower(2),upper(2)
+            DO i = lower(1),upper(1)
+              IF (variable1%array4(i,j,k,l) == Value) then
+                variable1%array4(i,j,k,l)=Variable2%array4(i,j,k,l)
+              ENDIF
+            ENDDO
+            ENDDO
+            ENDDO
+            ENDDO
+      CASE (5)
+            DO m = lower(5),upper(5)
+            DO l = lower(4),upper(4)
+            DO k = lower(3),upper(3)
+            DO j = lower(2),upper(2)
+            DO i = lower(1),upper(1)
+              IF (variable1%array5(i,j,k,l,m) == Value) then
+              variable1%array5(i,j,k,l,m)=Variable2%array5(i,j,k,l,m)
+              ENDIF
+            ENDDO
+            ENDDO
+            ENDDO
+            ENDDO
+            ENDDO
+      CASE (6)
+            DO n = lower(6),upper(6)
+            DO m = lower(5),upper(5)
+            DO l = lower(4),upper(4)
+            DO k = lower(3),upper(3)
+            DO j = lower(2),upper(2)
+            DO i = lower(1),upper(1)
+              IF (variable1%array6(i,j,k,l,m,n) == Value) then
+            variable1%array6(i,j,k,l,m,n)=Variable2%array6(i,j,k,l,m,n)
+              ENDIF
+            ENDDO
+            ENDDO
+            ENDDO
+            ENDDO
+            ENDDO
+            ENDDO
+      END SELECT
+C
+      return
+C
+      End Subroutine Where_ValTabToTab_mpi    
+#endif
+
+C     **************************************************************************
+CCC   Subroutine PreProcessToInterpOrUpdate
+C     **************************************************************************
+C
+      Subroutine PreProcessToInterpOrUpdate(parent,child,
+     &             petab_Child,
+     &             pttab_Child,pttab_Parent,
+     &             s_Child,s_Parent,
+     &             ds_Child,ds_Parent,
+     &             nbdim)
+C
+CCC   Description:
+CCC   
+C
+C     Declarations:
+C      
+C     arguments                                   
+      TYPE(AGRIF_PVariable) :: parent   ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child    ! Variable on the child grid
+      INTEGER :: nbdim                  
+      INTEGER,DIMENSION(6) :: pttab_child  
+      INTEGER,DIMENSION(6) :: petab_child      
+      INTEGER,DIMENSION(6) :: pttab_parent  
+      TYPE(AGRIF_Variable), Pointer :: root ! Pointer on the variable of the 
+                                            ! root grid
+      TYPE(Agrif_Grid), Pointer :: Agrif_Child_Gr,Agrif_Parent_Gr
+      REAL, DIMENSION(6) :: s_child,s_parent
+      REAL, DIMENSION(6) :: ds_child,ds_parent
+C     locals variables
+      INTEGER :: n
+      
+C
+C     Arguments      
+C
+
+C
+C     Local variables       
+C
+      Agrif_Child_Gr => Agrif_Curgrid
+      Agrif_Parent_Gr => Agrif_Curgrid % parent
+C
+      root => child % var % root_var 
+C
+C     Number of dimensions of the current grid
+      nbdim = root % nbdim
+C      
+      do n=1,nbdim
+C            
+        Select case(root % interptab(n))
+C
+C       Value of interptab(n) can be either x,y,z or N for a no space 
+C       DIMENSION            
+C
+C         The DIMENSION is 'x'
+          case('x')
+C
+            pttab_Child(n) = root % point(1)
+C            
+            pttab_Parent(n) = root % point(1)
+C        
+            s_Child(n) = Agrif_Child_Gr % Agrif_x(1)
+C
+            s_Parent(n) = Agrif_Parent_Gr % Agrif_x(1)
+C        
+            ds_Child(n) = Agrif_Child_Gr % Agrif_d(1)
+C
+            ds_Parent(n) = Agrif_Parent_Gr % Agrif_d(1)
+C                      
+            if (root % posvar(n).EQ.1) then
+C          
+              petab_Child(n) = pttab_Child(n) + Agrif_Child_Gr%nb(1)
+C        
+              else
+C          
+                petab_Child(n) = pttab_Child(n) + 
+     &                              Agrif_Child_Gr%nb(1) - 1
+C          
+                s_Child(n) = s_Child(n) + ds_Child(n)/2.
+C
+                s_Parent(n) = s_Parent(n) + ds_Parent(n)/2.
+C        
+            endif                  
+C
+C         The DIMENSION is 'y'
+          case('y')
+C
+            pttab_Child(n) = root % point(2)
+C            
+            pttab_Parent(n) = root % point(2)
+C        
+            s_Child(n) = Agrif_Child_Gr % Agrif_x(2)
+C
+            s_Parent(n) = Agrif_Parent_Gr % Agrif_x(2) 
+C        
+            ds_Child(n) = Agrif_Child_Gr % Agrif_d(2)
+C
+            ds_Parent(n) = Agrif_Parent_Gr % Agrif_d(2)
+C                      
+            if (root % posvar(n).EQ.1) then
+C          
+             petab_Child(n) = pttab_Child(n) + Agrif_Child_Gr%nb(2)
+C          
+              else
+C          
+                petab_Child(n) = pttab_Child(n) + 
+     &                       Agrif_Child_Gr%nb(2) - 1
+C          
+                s_Child(n) = s_Child(n) + ds_Child(n)/2.
+C
+                s_Parent(n) = s_Parent(n) + ds_Parent(n)/2.
+C        
+            endif
+            
+C
+C         The DIMENSION is 'z'                            
+          case('z')
+C
+            pttab_Child(n) = root % point(3)
+C            
+            pttab_Parent(n) = root % point(3)
+C        
+            s_Child(n) = Agrif_Child_Gr % Agrif_x(3)
+C
+            s_Parent(n) = Agrif_Parent_Gr % Agrif_x(3)
+C        
+            ds_Child(n) = Agrif_Child_Gr % Agrif_d(3)
+C
+            ds_Parent(n) = Agrif_Parent_Gr % Agrif_d(3)
+C                      
+            if (root % posvar(n).EQ.1) then
+C          
+             petab_Child(n) = pttab_Child(n) + Agrif_Child_Gr%nb(3)
+C          
+              else
+C          
+                petab_Child(n) = pttab_Child(n) + 
+     &                      Agrif_Child_Gr%nb(3) - 1
+C
+                s_Child(n) = s_Child(n) + ds_Child(n)/2.
+C
+                s_Parent(n) = s_Parent(n) + ds_Parent(n)/2.
+C        
+            endif       
+C 
+C         The DIMENSION is not space                            
+          case('N')
+C
+C         The next coefficients are calculated in order to do a simple copy of 
+C         values of the grid variable when the procedure of interpolation is 
+C         called for this DIMENSION 
+C      
+            Call Agrif_nbdim_Get_bound(child % var,
+     &                           pttab_Child(n),petab_Child(n),n,nbdim)
+C
+C           No interpolation but only a copy of the values of the grid variable
+C
+            pttab_Parent(n) = pttab_Child(n)
+C              
+            s_Child(n)=0.
+C      
+            s_Parent(n)=0. 
+C      
+            ds_Child(n)=1.
+C      
+            ds_Parent(n)=1.
+C
+        End select
+C            
+      enddo     
+C
+      return
+C
+      End Subroutine PreProcessToInterpOrUpdate     
+
+#ifdef key_mpp_mpi
+C
+C     **************************************************************************
+CCC   Subroutine GetLocalBoundaries
+C     **************************************************************************
+C
+      Subroutine GetLocalBoundaries(tab1,tab2,i,lb,ub,deb,fin)
+C
+CCC   Descritpion:
+C 
+C
+C     Declarations:
+C
+
+C
+C
+C     Scalar arguments
+      INTEGER  ::  tab1,tab2
+      INTEGER  ::  i
+      INTEGER  ::  lb,ub
+      INTEGER  ::  deb,fin
+C
+C     Local scalars
+      INTEGER  ::  imin,imax
+      INTEGER  ::  i1,i2
+C
+C
+      Call AGRIF_InvLoc(lb,AGRIF_ProcRank,i,imin)
+C
+      Call AGRIF_InvLoc(ub,AGRIF_ProcRank,i,imax)
+C
+C
+      if (imin > tab2) then
+C
+          i1 = imax - imin
+C
+        else
+C
+          i1 = max(tab1 - imin,0)
+C
+      endif
+C
+      if (imax < tab1) then
+C
+          i2 = -(imax - imin)
+C
+        else
+C
+          i2 = min(tab2 - imax,0)
+C
+      endif
+C
+      deb = lb + i1
+C
+      fin = ub + i2
+C
+C
+      End Subroutine GetLocalBoundaries
+C
+#endif
+C
+C
+#ifdef key_mpp_mpi
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_GlobtoLocInd2
+C     **************************************************************************
+C
+      Subroutine Agrif_GlobtoLocInd2(tabarray,lboundl,uboundl,tab1,tab2,
+     &                              nbdim,rank,member)
+C
+CCC   Description:
+CCC   For a global index located on the current processor, tabarray gives the 
+CCC   corresponding local index   
+C
+C
+C     Declarations:
+C
+
+C
+C     Arguments
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim) :: tab1,tab2
+      INTEGER,DIMENSION(nbdim,2,2 ) :: tabarray
+      INTEGER,DIMENSION(nbdim) :: lboundl,uboundl
+      INTEGER :: rank
+      LOGICAL :: member
+C    
+C     Local variables
+      INTEGER :: i,i1,k
+      INTEGER :: nbloc(nbdim)
+C
+C
+      tabarray(:,1,:) =  HUGE(1)
+      tabarray(:,2,:) =  -HUGE(1)
+
+      nbloc = 0
+C        
+      do i = 1,nbdim
+C       
+        Call Agrif_Invloc(lboundl(i),rank,i,i1)
+        
+        do k=tab1(i)+lboundl(i)-i1,tab2(i)+lboundl(i)-i1
+          IF ((k .GE. lboundl(i)) .AND. (k.LE.uboundl(i))) THEN
+            nbloc(i) = 1
+            tabarray(i,1,1) = min(tabarray(i,1,1),k-lboundl(i)+i1)
+            tabarray(i,2,1) = max(tabarray(i,2,1),k-lboundl(i)+i1)
+        
+            tabarray(i,1,2) = min(tabarray(i,1,2),k)
+            tabarray(i,2,2) = max(tabarray(i,2,2),k)
+          ENDIF
+        enddo
+C
+      enddo
+
+      member = .FALSE.
+      IF (sum(nbloc) == nbdim) member = .TRUE.
+C
+      Return
+C
+C
+      End Subroutine Agrif_GlobtoLocInd2
+C
+#endif      
+
+      Subroutine Agrif_Copy_2d(tabout,tabin,l,m,inf,sup,inf2,sup2)
+      integer,dimension(2) :: l,m,inf,sup,inf2,sup2
+      real,target,dimension(l(1):,l(2):) :: tabout
+      real,target,dimension(m(1):,m(2):) :: tabin
+          tabout(inf(1):sup(1),
+     &                         inf(2):sup(2)) = 
+     &         tabin(inf2(1):sup2(1),
+     &                          inf2(2):sup2(2))
+      End Subroutine Agrif_Copy_2d
+      
+      Subroutine Agrif_Copy_3d(tabout,tabin,l,m,inf,sup,inf2,sup2)
+      integer,dimension(3) :: l,m,inf,sup,inf2,sup2
+      real,target,dimension(l(1):,l(2):,l(3):) :: tabout
+      real,target,dimension(m(1):,m(2):,m(3):) :: tabin
+          tabout(inf(1):sup(1),
+     &                         inf(2):sup(2), 
+     &                         inf(3):sup(3)) = 
+     &         tabin(inf2(1):sup2(1),
+     &                          inf2(2):sup2(2),
+     &                          inf2(3):sup2(3))
+      End Subroutine Agrif_Copy_3d
+      
+      Subroutine Agrif_Copy_4d(tabout,tabin,l,m,inf,sup,inf2,sup2)
+      integer,dimension(4) :: l,m,inf,sup,inf2,sup2
+      real,target,dimension(l(1):,l(2):,l(3):,l(4):) :: tabout
+      real,target,dimension(m(1):,m(2):,m(3):,m(4):) :: tabin
+          tabout(inf(1):sup(1),
+     &                         inf(2):sup(2), 
+     &                         inf(3):sup(3), 
+     &                         inf(4):sup(4)) = 
+     &         tabin(inf2(1):sup2(1),
+     &                          inf2(2):sup2(2),
+     &                          inf2(3):sup2(3),
+     &                          inf2(4):sup2(4))
+      End Subroutine Agrif_Copy_4d      
+
+      End Module Agrif_Arrays
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F	(revision 8201)
@@ -0,0 +1,1337 @@
+!
+! $Id: modbc.F 2731 2011-04-08 12:05:35Z rblod $
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_Boundary 
+C 
+      Module Agrif_Boundary  
+C
+CCC   Description:
+CCC   Module to calculate the boundary conditions on the child grids from their
+CCC   parent grids.
+C
+C     Modules used:  
+C   
+      Use Agrif_Interpolation        
+C
+      IMPLICIT NONE
+C        
+      CONTAINS   
+C     Define procedures contained in this module
+C
+C
+      
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_bc_1d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_bc_1d(TypeInterp,parent,child,tab,deb,fin,
+     &                              weight,pweight,procname)
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions on a fine grid for a 1D 
+CCC   grid variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+      External :: procname
+      Optional :: procname
+      INTEGER,DIMENSION(6,6) :: TypeInterp    ! TYPE of interpolation (linear, 
+                                            ! lagrange, spline, ... )
+      TYPE(AGRIF_PVariable) :: parent       ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child        ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp    ! Temporary variable on the child 
+                                            ! grid
+      INTEGER :: deb,fin                    ! Positions where interpolations are
+                                            ! done on the fine grid 
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1) 
+     &    ), Target :: tab ! Values of the grid variable
+      LOGICAL :: pweight                    ! Indicates if weight is used for  
+                                            ! the temporal interpolation 
+      REAL :: weight                        ! Coefficient for the time 
+                                            ! interpolation
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE representing the grid
+C     variable.   
+C
+      allocate(childtemp % var)  
+C
+      childtemp % var % root_var => child % var % root_var
+C      
+C     Values of the grid variable
+      childtemp % var % parray1 => tab  
+C
+C     Temporary results for the time interpolation before and after the space 
+C     interpolation 
+      childtemp % var % oldvalues2D => child % var % oldvalues2D
+C 
+C     Index indicating if a space interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex       
+      childtemp % var % Interpolationshouldbemade = 
+     &                 child % var % Interpolationshouldbemade   
+      childtemp % var % list_interp => child % var% list_interp 
+      
+      childtemp % var% lb = child % var % lb
+      childtemp % var% ub = child % var % ub         
+C
+C     Call to the procedure for the calculations of the boundary conditions
+      IF (present(procname)) THEN
+      Call Agrif_CorrectVariable
+     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight,procname)
+      ELSE
+      Call Agrif_CorrectVariable
+     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight)
+      ENDIF
+
+C   
+      child % var % oldvalues2D => childtemp % var % oldvalues2D
+      child % var % list_interp => childtemp % var %list_interp
+C         
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_bc_1D
+C
+      
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_bc_2d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_bc_2d(TypeInterp,parent,child,tab,deb,fin,
+     &                              weight,pweight,procname)
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions on a fine grid for a 2D 
+CCC   grid variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+      External :: procname
+      Optional :: procname
+      INTEGER,DIMENSION(6,6) :: TypeInterp    ! TYPE of interpolation (linear, 
+                                            ! lagrange, spline, ... )
+      TYPE(AGRIF_PVariable) :: parent       ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child        ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp    ! Temporary variable on the child 
+                                            ! grid
+      INTEGER :: deb,fin                    ! Positions where interpolations are
+                                            ! done on the fine grid 
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2) 
+     &    ), Target :: tab ! Values of the grid variable
+      LOGICAL :: pweight                    ! Indicates if weight is used for  
+                                            ! the temporal interpolation 
+      REAL :: weight                        ! Coefficient for the time 
+                                            ! interpolation
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE representing the grid
+C     variable.   
+C
+      allocate(childtemp % var)  
+C
+      childtemp % var % root_var => child % var % root_var
+C      
+C     Values of the grid variable
+      childtemp % var % parray2 => tab  
+C
+C     Temporary results for the time interpolation before and after the space 
+C     interpolation 
+      childtemp % var % oldvalues2D => child % var % oldvalues2D
+C 
+C     Index indicating if a space interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex       
+      childtemp % var % Interpolationshouldbemade = 
+     &                 child % var % Interpolationshouldbemade   
+      childtemp % var % list_interp => child % var% list_interp 
+      
+      childtemp % var% lb = child % var % lb
+      childtemp % var% ub = child % var % ub         
+C
+C     Call to the procedure for the calculations of the boundary conditions
+      IF (present(procname)) THEN
+      Call Agrif_CorrectVariable
+     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight,procname)
+      ELSE
+      Call Agrif_CorrectVariable
+     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight)
+      ENDIF
+
+C   
+      child % var % oldvalues2D => childtemp % var % oldvalues2D
+      child % var % list_interp => childtemp % var %list_interp
+C         
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_bc_2D
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_bc_3d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_bc_3d(TypeInterp,parent,child,tab,deb,fin,
+     &                              weight,pweight,procname)            
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions on a fine grid for a 3D 
+CCC   variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments 
+      External :: procname
+      Optional :: procname     
+      INTEGER,DIMENSION(6,6) :: TypeInterp    ! TYPE of interpolation (linear, 
+                                            ! lagrange, spline, ... )
+      TYPE(AGRIF_PVariable) :: parent       ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child        ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp    ! Temporary variable on the child
+                                            ! grid
+      INTEGER :: deb,fin                    ! Positions where interpolations 
+                                            ! are done on the fine grid 
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3)
+     &         ), Target :: tab ! Values of the grid variable
+      LOGICAL :: pweight                    ! Indicates if weight is used for 
+                                            ! the temporal interpolation 
+      REAL :: weight                        ! Coefficient for the time 
+                                            ! interpolation
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE representing the grid 
+C     variable.  
+C
+      allocate(childtemp % var)  
+C
+      childtemp % var % root_var => child % var % root_var       
+C      
+C     Values of the grid variable
+      childtemp % var % parray3 => tab
+C
+C     Temporary results for the time interpolation before and after the space 
+C     interpolation  
+      childtemp % var % oldvalues2D => child % var % oldvalues2D
+C 
+C     Index indicating if a space interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex
+      childtemp % var % Interpolationshouldbemade = 
+     &                 child % var % Interpolationshouldbemade 
+      childtemp % var % list_interp => child % var% list_interp 
+      
+      childtemp % var% lb = child % var % lb
+      childtemp % var% ub = child % var % ub
+C
+C     Call to the procedure for the calculations of the boundary conditions     
+      IF (present(procname)) THEN
+      Call Agrif_CorrectVariable
+     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight,procname)
+      ELSE
+      Call Agrif_CorrectVariable
+     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight)
+      ENDIF
+C
+      child % var % oldvalues2D => childtemp % var % oldvalues2D
+      child % var % list_interp => childtemp % var %list_interp      
+C      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_bc_3D               
+C
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_bc_4d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_bc_4d(TypeInterp,parent,child,tab,deb,fin,
+     &                             weight,pweight,procname)            
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions on a fine grid for a 4D 
+CCC   grid variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+      External :: procname
+      Optional :: procname     
+      INTEGER,DIMENSION(6,6) :: TypeInterp      ! TYPE of interpolation (linear, 
+                                              ! lagrange, spline, ... )
+      TYPE(AGRIF_PVariable) :: parent         ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child          ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp      ! Temporary varaiable on the child
+                                              ! grid
+      INTEGER :: deb,fin                      ! Positions where interpolations 
+                                              ! are done on the fine grid 
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3),
+     &         child%var%lb(4):child%var%ub(4)
+     &        ), Target :: tab ! Values of the grid variable
+      LOGICAL :: pweight                      ! Indicates if weight is used for 
+                                              ! the temporal interpolation 
+      REAL :: weight                          ! Coefficient for the time 
+                                              ! interpolation
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE representing the grid 
+C     variable.  
+C
+      allocate(childtemp % var)  
+C
+      childtemp % var % root_var => child % var % root_var 
+C      
+C     Values of the grid variable
+      childtemp % var % parray4 => tab  
+C
+C     Temporary results for the time interpolation before and after the space 
+C     interpolation       
+      childtemp % var % oldvalues2D => child % var % oldvalues2D
+C 
+C     Index indicating if a space interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex       
+      childtemp % var % Interpolationshouldbemade = 
+     &                 child % var % Interpolationshouldbemade  
+      childtemp % var % list_interp => child % var% list_interp 
+      
+      childtemp % var% lb = child % var % lb
+      childtemp % var% ub = child % var % ub               
+C
+C     Call to the procedure for the calculations of the boundary conditions
+      IF (present(procname)) THEN
+      Call Agrif_CorrectVariable
+     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight,procname)
+      ELSE
+      Call Agrif_CorrectVariable
+     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight)
+      ENDIF
+C
+      child % var % oldvalues2D => childtemp % var % oldvalues2D
+      child % var % list_interp => childtemp % var %list_interp      
+C      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_bc_4D
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_bc_5d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_bc_5d(TypeInterp,parent,child,tab,deb,fin,
+     &                             weight,pweight,procname)            
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions on a fine grid for a 5D 
+CCC   grid variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+      External :: procname
+      Optional :: procname     
+      INTEGER,DIMENSION(6,6) :: TypeInterp      ! TYPE of interpolation (linear, 
+                                              ! lagrange, spline, ... )
+      TYPE(AGRIF_PVariable) :: parent         ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child          ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp      ! Temporary varaiable on the child
+                                              ! grid
+      INTEGER :: deb,fin                      ! Positions where interpolations 
+                                              ! are done on the fine grid 
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3),
+     &         child%var%lb(4):child%var%ub(4),
+     &         child%var%lb(5):child%var%ub(5)
+     &         ), Target :: tab ! Values of the grid variable
+      LOGICAL :: pweight                      ! Indicates if weight is used for 
+                                              ! the temporal interpolation 
+      REAL :: weight                          ! Coefficient for the time 
+                                              ! interpolation
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE representing the grid 
+C     variable.  
+C
+      allocate(childtemp % var)  
+C
+      childtemp % var % root_var => child % var % root_var 
+C      
+C     Values of the grid variable
+      childtemp % var % parray5 => tab  
+C
+C     Temporary results for the time interpolation before and after the space 
+C     interpolation       
+      childtemp % var % oldvalues2D => child % var % oldvalues2D
+C 
+C     Index indicating if a space interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex       
+      childtemp % var % Interpolationshouldbemade = 
+     &                 child % var % Interpolationshouldbemade 
+      childtemp % var % list_interp => child % var% list_interp  
+      
+      childtemp % var% lb = child % var % lb
+      childtemp % var% ub = child % var % ub
+                     
+C
+C     Call to the procedure for the calculations of the boundary conditions  
+      IF (present(procname)) THEN
+      Call Agrif_CorrectVariable
+     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight,procname)
+      ELSE
+      Call Agrif_CorrectVariable
+     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight)
+      ENDIF
+C
+      child % var % oldvalues2D => childtemp % var % oldvalues2D
+      child % var % list_interp => childtemp % var %list_interp      
+C      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_bc_5D
+C
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_bc_6d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_bc_6d(TypeInterp,parent,child,tab,deb,fin,
+     &                             weight,pweight)            
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions on a fine grid for a 6D 
+CCC   grid variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+      INTEGER,DIMENSION(6,6) :: TypeInterp      ! TYPE of interpolation (linear, 
+                                              ! lagrange, spline, ... )
+      TYPE(AGRIF_PVariable) :: parent         ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child          ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp      ! Temporary varaiable on the child
+                                              ! grid
+      INTEGER :: deb,fin                      ! Positions where interpolations 
+                                              ! are done on the fine grid 
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3),
+     &         child%var%lb(4):child%var%ub(4),
+     &         child%var%lb(5):child%var%ub(5),
+     &         child%var%lb(6):child%var%ub(6)
+     &         ), Target :: tab ! Values of the grid variable
+      LOGICAL :: pweight                      ! Indicates if weight is used for 
+                                              ! the temporal interpolation 
+      REAL :: weight                          ! Coefficient for the time 
+                                              ! interpolation
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE representing the grid 
+C     variable.  
+C
+      allocate(childtemp % var)  
+C
+      childtemp % var % root_var => child % var % root_var 
+C      
+C     Values of the grid variable
+      childtemp % var % parray6 => tab  
+C
+C     Temporary results for the time interpolation before and after the space 
+C     interpolation       
+      childtemp % var % oldvalues2D => child % var % oldvalues2D
+C 
+C     Index indicating if a space interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex       
+      childtemp % var % Interpolationshouldbemade = 
+     &                 child % var % Interpolationshouldbemade 
+      childtemp % var % list_interp => child % var% list_interp  
+      
+      childtemp % var% lb = child % var % lb
+      childtemp % var% ub = child % var % ub               
+C
+C     Call to the procedure for the calculations of the boundary conditions
+      Call Agrif_CorrectVariable
+     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight)
+C
+      child % var % oldvalues2D => childtemp % var % oldvalues2D
+      child % var % list_interp => childtemp % var %list_interp      
+C      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_bc_6D
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_CorrectVariable
+C     **************************************************************************
+C
+      Subroutine AGRIF_CorrectVariable(TypeInterp,parent,child,deb,fin,
+     &                                 pweight,weight,procname)
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions on a fine grid.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments
+      External :: procname
+      Optional :: procname
+      TYPE(AGRIF_PVariable) :: parent         ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child          ! Variable on the child grid
+      INTEGER,DIMENSION(6,6)  :: TypeInterp     ! TYPE of interpolation
+                                              !    (linear,lagrange,...)
+      INTEGER               :: deb,fin        ! Positions where boundary
+                                              !    conditions are calculated
+      LOGICAL               :: pweight        ! Indicates if weight is used 
+                                              !    for the time interpolation 
+      REAL                  :: weight         ! Coefficient for the time
+                                              !    interpolation
+C
+C     Local scalars
+      TYPE(Agrif_Grid)    , Pointer :: Agrif_Child_Gr,Agrif_Parent_Gr
+      TYPE(AGRIF_Variable), Pointer :: root   ! Variable on the root grid
+      INTEGER                       :: nbdim  ! Number of dimensions of 
+                                              !    the grid variable 
+      INTEGER                       :: n
+      INTEGER,DIMENSION(6)          :: pttab_child  ! Index of the first point
+                                                    !    inside the domain for
+                                                    !    the child grid variable
+      INTEGER,DIMENSION(6)          :: pttab_parent ! Index of the first point
+                                                    !    inside the domain for
+                                                    !    the parent grid
+                                                    !    variable
+      INTEGER,DIMENSION(6)          :: nbtab_Child  ! Number of the cells
+      INTEGER,DIMENSION(6)          :: posvartab_Child    ! Position of the
+                                                    !    variable on the cell 
+      INTEGER,DIMENSION(6)          :: loctab_Child ! Indicates if the child
+                                                    !    grid has a common
+                                                    !    border with the root
+                                                    !    grid      
+      REAL, DIMENSION(6)            :: s_child,s_parent   ! Positions of the
+                                                    !    parent and child grids
+      REAL, DIMENSION(6)            :: ds_child,ds_parent ! Space steps of the
+                                                    !    parent and child grids 
+C
+C
+      loctab_child(:) = 0
+C
+      Agrif_Child_Gr => Agrif_Curgrid
+      Agrif_Parent_Gr => Agrif_Curgrid % parent
+      root => child % var % root_var 
+      nbdim = root % nbdim
+C
+      do n = 1,nbdim
+        posvartab_child(n) = root % posvar(n)      
+      enddo
+C
+C
+      do n = 1,nbdim
+C
+        Select case(root % interptab(n))
+C
+          case('x') ! x DIMENSION
+C
+            nbtab_Child(n) = Agrif_Child_Gr % nb(1)
+            pttab_Child(n) = root % point(1)
+            pttab_Parent(n) = root % point(1)
+            s_Child(n) = Agrif_Child_Gr % Agrif_x(1)
+            s_Parent(n) = Agrif_Parent_Gr % Agrif_x(1)
+            ds_Child(n) = Agrif_Child_Gr % Agrif_d(1)
+            ds_Parent(n) = Agrif_Parent_Gr % Agrif_d(1)
+            if (root % posvar(n) == 2) then
+                s_Child(n) = s_Child(n) + ds_Child(n)/2.
+                s_Parent(n) = s_Parent(n) + ds_Parent(n)/2.
+            endif
+C
+            if (Agrif_CURGRID % NearRootBorder(1)) 
+     &         loctab_child(n) = -1
+            if (Agrif_CURGRID % DistantRootBorder(1))
+     &         loctab_child(n) = -2
+            if ((Agrif_CURGRID % NearRootBorder(1)) .AND. 
+     &          (Agrif_CURGRID % DistantRootBorder(1))) 
+     &         loctab_child(n) = -3
+C
+          case('y') ! y DIMENSION      
+C
+            nbtab_Child(n) = Agrif_Child_Gr % nb(2)
+            pttab_Child(n) = root % point(2)
+            pttab_Parent(n) = root % point(2)
+            s_Child(n) = Agrif_Child_Gr % Agrif_x(2)
+            s_Parent(n) = Agrif_Parent_Gr % Agrif_x(2) 
+            ds_Child(n) = Agrif_Child_Gr % Agrif_d(2)
+            ds_Parent(n) = Agrif_Parent_Gr % Agrif_d(2)
+            if (root % posvar(n) == 2) then        
+                s_Child(n) = s_Child(n) + ds_Child(n)/2.
+                s_Parent(n) = s_Parent(n) + ds_Parent(n)/2.
+            endif        
+C
+            if (Agrif_CURGRID % NearRootBorder(2)) 
+     &         loctab_child(n) = -1
+            if (Agrif_CURGRID % DistantRootBorder(2)) 
+     &         loctab_child(n) = -2
+            if ((Agrif_CURGRID % NearRootBorder(2)) .AND. 
+     &          (Agrif_CURGRID % DistantRootBorder(2))) 
+     &         loctab_child(n) = -3
+C
+          case('z') ! z DIMENSION
+C
+            nbtab_Child(n) = Agrif_Child_Gr % nb(3)
+            pttab_Child(n) = root % point(3)
+            pttab_Parent(n) = root % point(3)
+            s_Child(n) = Agrif_Child_Gr % Agrif_x(3)
+            s_Parent(n) = Agrif_Parent_Gr % Agrif_x(3)
+            ds_Child(n) = Agrif_Child_Gr % Agrif_d(3)
+            ds_Parent(n) = Agrif_Parent_Gr % Agrif_d(3)
+            if (root % posvar(n) == 2) then        
+                s_Child(n) = s_Child(n) + ds_Child(n)/2.
+                s_Parent(n) = s_Parent(n) + ds_Parent(n)/2.
+            endif        
+C
+            if (Agrif_CURGRID % NearRootBorder(3)) 
+     &         loctab_child(n) = -1
+            if (Agrif_CURGRID % DistantRootBorder(3)) 
+     &         loctab_child(n) = -2
+            if ((Agrif_CURGRID % NearRootBorder(3)) .AND. 
+     &          (Agrif_CURGRID % DistantRootBorder(3))) 
+     &         loctab_child(n) = -3
+C
+          case('N') ! No space DIMENSION      
+C
+            nbtab_Child(n) = child % var % ub(n) - child % var % lb(n)
+            pttab_Child(n) = child % var % lb(n)
+C
+C           No interpolation but only a copy of the values of the grid variable
+C      
+            posvartab_child(n) = 1
+            pttab_Parent(n)= pttab_Child(n)
+            s_Child(n)=0.
+            s_Parent(n)=0. 
+            ds_Child(n)=1.
+            ds_Parent(n)=1.
+            loctab_child(n) = -3
+C
+        End select
+C
+      enddo
+C
+         IF (present(procname)) THEN
+          Call AGRIF_CorrectnD
+     &         (TypeInterp,parent,child,deb,fin,pweight,weight,
+     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
+     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
+     &          loctab_Child(1:nbdim),
+     &          s_Child(1:nbdim),s_Parent(1:nbdim),
+     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim,procname)
+        ELSE
+          Call AGRIF_CorrectnD
+     &         (TypeInterp,parent,child,deb,fin,pweight,weight,
+     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
+     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
+     &          loctab_Child(1:nbdim),
+     &          s_Child(1:nbdim),s_Parent(1:nbdim),
+     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim)
+         ENDIF
+C
+C
+      End subroutine AGRIF_CorrectVariable
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Correctnd
+C     **************************************************************************
+C
+      Subroutine AGRIF_Correctnd(TypeInterp,parent,child,deb,fin,
+     &                           pweight,weight,
+     &                           pttab_child,pttab_Parent,
+     &                           nbtab_Child,posvartab_Child,
+     &                           loctab_Child,
+     &                           s_Child,s_Parent,
+     &                           ds_Child,ds_Parent,nbdim,procname)
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions for a nD grid variable on 
+CCC   a fine grid by using a space and time interpolations; it is called by the 
+CCC   Agrif_CorrectVariable procedure.
+C
+C
+C     Declarations:
+C
+      
+C
+#ifdef key_mpp_mpi
+C
+      INCLUDE 'mpif.h'
+C
+#endif
+C
+C     Arguments
+      External :: procname
+      Optional :: procname
+      INTEGER,DIMENSION(6,6) :: TypeInterp ! TYPE of interpolation (linear, 
+                                         !   spline,...)  
+      TYPE(AGRIF_PVariable)    :: parent ! Variable on the parent grid
+      TYPE(AGRIF_PVariable)    :: child  ! Variable on the child grid 
+      INTEGER                  :: deb,fin ! Positions where interpolations 
+                                         !    are done
+      LOGICAL                  :: pweight ! Indicates if weight is used for 
+                                         !    the temporal interpolation
+      REAL                     :: weight ! Coefficient for the temporal
+                                         !    interpolation
+      INTEGER                  :: nbdim  ! Number of dimensions of the grid
+                                         !    variable
+      INTEGER,DIMENSION(nbdim) :: pttab_child ! Index of the first point inside
+                                         !    the domain for the parent 
+                                         !    grid variable
+      INTEGER,DIMENSION(nbdim) :: pttab_Parent ! Index of the first point 
+                                         !   inside the domain for the 
+                                         !   child grid variable
+      INTEGER,DIMENSION(nbdim) :: nbtab_Child ! Number of cells of the child
+                                         !    grid
+      INTEGER,DIMENSION(nbdim) :: posvartab_Child ! Position of the grid
+                                         !    variable (1 or 2)
+      INTEGER,DIMENSION(nbdim) :: loctab_Child ! Indicates if the child 
+                                        !    grid has a common border with 
+                                        !    the root grid
+      REAL   ,DIMENSION(nbdim) :: s_Child,s_Parent ! Positions of the parent 
+                                        !   and child grids 
+      REAL   ,DIMENSION(nbdim) :: ds_Child,ds_Parent ! Space steps of the 
+                                        !    parent and child grids
+C
+C     Local variables
+      TYPE(AGRIF_PVariable)        :: restore ! Variable on the parent     
+      INTEGER,DIMENSION(nbdim,2)   :: lubglob
+      INTEGER                      :: i          
+      INTEGER                      :: kindex  ! Index used for safeguard 
+                                       !    and time interpolation
+      INTEGER,DIMENSION(nbdim,2,2) :: indtab ! Arrays indicating the limits 
+                                       !    of the child     
+      INTEGER,DIMENSION(nbdim,2,2) :: indtruetab ! grid variable where 
+                                       !   boundary conditions are 
+      INTEGER,DIMENSION(nbdim,2,2,nbdim)   :: ptres,ptres2 ! calculated
+      INTEGER                      :: nb,ndir,n,sizetab(1)
+      REAL, DIMENSION(:), Allocatable :: tab ! Array used for the interpolation
+      REAL    :: c1t,c2t               ! Coefficients for the time interpolation
+                                       !    (c2t=1-c1t) 
+C
+#ifdef key_mpp_mpi
+C
+      INTEGER,DIMENSION(nbdim)   :: lower,upper
+      INTEGER,DIMENSION(nbdim)   :: ltab,utab
+      INTEGER,DIMENSION(nbdim)   :: lb,ub
+      INTEGER,DIMENSION(nbdim,2) :: iminmaxg
+      INTEGER                    :: code
+C
+#endif            
+C      
+C
+      indtab(1:nbdim,2,1) = pttab_child(1:nbdim) + nbtab_child(1:nbdim)
+     &          + deb
+      indtab(1:nbdim,2,2) = indtab(1:nbdim,2,1) + ( fin - deb )
+       
+      indtab(1:nbdim,1,1) = pttab_child(1:nbdim) - fin
+      indtab(1:nbdim,1,2) = pttab_child(1:nbdim) - deb
+                  
+      WHERE (posvartab_child(1:nbdim) == 2)
+        indtab(1:nbdim,1,1) = indtab(1:nbdim,1,1) - 1
+        indtab(1:nbdim,1,2) = indtab(1:nbdim,1,2) - 1
+      END WHERE
+      
+
+#if !defined key_mpp_mpi
+      Call Agrif_nbdim_Get_bound_dimension(child%var,lubglob(:,1),
+     &              lubglob(:,2),nbdim)
+C
+#else
+C     
+      Call Agrif_nbdim_Get_bound_dimension(child%var,lb,ub,nbdim)
+      
+      DO i = 1,nbdim
+C
+        Call Agrif_Invloc(lb(i),Agrif_Procrank,i,iminmaxg(i,1))
+        Call Agrif_Invloc(ub(i),Agrif_Procrank,i,iminmaxg(i,2))
+C
+      ENDDO
+C
+      iminmaxg(1:nbdim,2) = - iminmaxg(1:nbdim,2)
+      
+      CALL MPI_ALLREDUCE(iminmaxg,lubglob,2*nbdim,MPI_INTEGER,MPI_MIN,
+     &                     MPI_COMM_AGRIF,code)  
+     
+      lubglob(1:nbdim,2) = - lubglob(1:nbdim,2)      
+C
+#endif 
+C     
+      indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1),
+     &     lubglob(1:nbdim,1))
+      indtruetab(1:nbdim,1,2) = max(indtab(1:nbdim,1,2),
+     &     lubglob(1:nbdim,1))
+      indtruetab(1:nbdim,2,1) = min(indtab(1:nbdim,2,1),
+     &     lubglob(1:nbdim,2))
+      indtruetab(1:nbdim,2,2) = min(indtab(1:nbdim,2,2),
+     &     lubglob(1:nbdim,2))
+
+                              
+C 
+C
+      do nb = 1,nbdim
+C
+        do ndir = 1,2      
+C
+          if (loctab_child(nb) /= (-ndir) 
+     &        .AND. loctab_child(nb) /= -3) then
+C           
+              do n = 1,2
+C
+                ptres(nb,n,ndir,nb) = indtruetab(nb,ndir,n)  
+C
+              enddo              
+C
+              do i = 1,nbdim
+C     
+                if (i .NE. nb) then      
+C
+                    if (loctab_child(i) == -1 
+     &                                 .OR. loctab_child(i) == -3) then
+C
+                        ptres(i,1,ndir,nb) = pttab_child(i)
+C
+                      else
+C
+                        ptres(i,1,ndir,nb) = indtruetab(i,1,1)
+C
+                    endif
+C
+                    if (loctab_child(i) == -2 
+     &                                 .OR. loctab_child(i) == -3) then
+C
+                        if (posvartab_child(i) == 1) then
+C
+                            ptres(i,2,ndir,nb) = pttab_child(i)
+     &                                                 + nbtab_child(i)
+C
+                          else
+C
+                            ptres(i,2,ndir,nb) = pttab_child(i)
+     &                                             + nbtab_child(i) - 1
+C
+                        endif                             
+C
+                      else
+C
+                        ptres(i,2,ndir,nb) = indtruetab(i,2,2)
+C
+                    endif                        
+C      
+                endif
+C      
+              enddo
+      
+C
+#if defined key_mpp_mpi
+                 Call Agrif_nbdim_Get_bound_dimension
+     &                    (child%var,lower,upper,nbdim)
+
+              do i = 1,nbdim
+C
+                 Call GetLocalBoundaries(ptres(i,1,ndir,nb),
+     &                                  ptres(i,2,ndir,nb),i,
+     &                                  lower(i),upper(i),
+     &                                  ltab(i),utab(i))
+                 ptres2(i,1,ndir,nb) = max(ltab(i),lower(i)) 
+                 ptres2(i,2,ndir,nb) = min(utab(i),upper(i))
+                 if ((i == nb) .AND. (ndir == 1)) then 
+                     ptres2(i,2,ndir,nb) = max(utab(i),lower(i))
+                 elseif ((i == nb) .AND. (ndir == 2)) then
+                     ptres2(i,1,ndir,nb) = min(ltab(i),upper(i)) 
+                 endif
+C
+              enddo
+#else
+              ptres2(:,:,ndir,nb) = ptres(:,:,ndir,nb)
+#endif      
+            
+        endif
+      
+        enddo
+       enddo
+C
+      if (child % var % interpIndex 
+     &        /= Agrif_Curgrid % parent % ngridstep .OR.
+     &    child%var%Interpolationshouldbemade ) then
+C
+C     Space interpolation 
+C      
+      kindex = 1    
+      
+
+C
+      do nb = 1,nbdim
+C
+        do ndir = 1,2
+C
+          if (loctab_child(nb) /= (-ndir) 
+     &        .AND. loctab_child(nb) /= -3) then  
+C
+              IF (present(procname)) THEN
+              Call Agrif_InterpnD
+     &             (TYPEInterp(nb,:),parent,child,
+     &              ptres(1:nbdim,1,ndir,nb),ptres(1:nbdim,2,ndir,nb),
+     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
+     &              s_Child(1:nbdim),s_Parent(1:nbdim),
+     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
+     &              restore,.FALSE.,nbdim,procname)
+              ELSE
+              Call Agrif_InterpnD              
+     &             (TYPEInterp(nb,:),parent,child,
+     &              ptres(1:nbdim,1,ndir,nb),ptres(1:nbdim,2,ndir,nb),
+     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
+     &              s_Child(1:nbdim),s_Parent(1:nbdim),
+     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
+     &              restore,.FALSE.,nbdim)
+              ENDIF
+     
+              IF (.NOT. child%var%interpolationshouldbemade) THEN
+C     
+C             Safeguard of the values of the grid variable (at times n and n+1
+C                on the parent grid)
+C      
+              sizetab(1) = 1
+C
+              do i = 1,nbdim
+C          
+                sizetab(1) = sizetab(1)
+     &              * (ptres2(i,2,ndir,nb)-ptres2(i,1,ndir,nb)+1)
+C      
+              enddo
+
+              Call saveAfterInterp(child,
+     &           ptres2(:,:,ndir,nb),kindex,sizetab(1),nbdim)
+C
+           ENDIF
+C
+          endif
+C
+        enddo       
+C
+      enddo     
+C
+C
+      child % var % interpIndex = Agrif_Curgrid % parent % ngridstep
+C
+C
+      endif  
+      
+              IF (.NOT. child%var%interpolationshouldbemade) THEN
+C
+C
+C     Calculation of the coefficients c1t and c2t for the temporary
+C        interpolation
+      if (pweight) then
+C
+          c1t = weight
+C
+        else
+C
+          c1t = (REAL(AGRIF_Nbstepint()) + 1.) / Agrif_Rhot()
+C
+      endif
+C                                  
+      c2t = 1. - c1t
+C           
+C     Time interpolation
+C
+      kindex = 1
+C
+      do nb = 1,nbdim
+C
+        do ndir = 1,2      
+C
+          if (loctab_child(nb) /= (-ndir) 
+     &        .AND. loctab_child(nb) /= -3) then
+
+              Call timeInterpolation
+     &             (child,ptres2(:,:,ndir,nb),kindex,c1t,c2t,nbdim)
+          endif
+C
+        enddo
+C      
+      enddo
+C      
+
+       ENDIF
+C  
+      End Subroutine Agrif_Correctnd
+C
+C
+C     **************************************************************************
+CCC   Subroutine saveAfterInterp
+C     **************************************************************************
+C
+      Subroutine saveAfterInterp(child,bounds,kindex,newsize,nbdim)
+C
+CCC   Descritpion:
+CCC   Subroutine used to save the values of the grid variable on the fine grid 
+CCC   after the space interpolation. 
+C
+C     Declarations:
+C
+      
+C
+C     argument
+      TYPE (AGRIF_PVariable) :: child   ! The fine grid variable
+      INTEGER                :: kindex  ! Index indicating where this safeguard 
+                                        ! is done on the fine grid
+      INTEGER :: nbdim, newsize
+      INTEGER,DIMENSION(nbdim,2) :: bounds
+C
+C     Local scalars
+      INTEGER                      :: ir,jr,kr,lr,mr,nr
+C
+C
+C     Allocation of the array oldvalues2d
+
+C
+      if (newsize .LE. 0) return
+C
+      Call Agrif_Checksize
+     &     (child,kindex+newsize)  
+
+      if (child % var % interpIndex 
+     &        /= Agrif_Curgrid % parent % ngridstep ) then
+       child%var%oldvalues2d(1,kindex:kindex+newsize-1)=
+     &        child%var%oldvalues2d(2,kindex:kindex+newsize-1)
+      endif
+
+      SELECT CASE (nbdim)
+      CASE (1)
+
+!CDIR ALTCODE
+         do ir=bounds(1,1),bounds(1,2)
+            child%var%oldvalues2d(2,kindex) =
+     &           child%var%parray1(ir)
+            kindex = kindex + 1
+         enddo       
+C
+      CASE (2)
+
+        do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+           do ir=bounds(1,1),bounds(1,2)
+            child%var%oldvalues2d(2,kindex) =
+     &           child%var%parray2(ir,jr)
+            kindex = kindex + 1
+           enddo
+         enddo      
+C
+      CASE (3)
+        do kr=bounds(3,1),bounds(3,2)
+          do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+             do ir=bounds(1,1),bounds(1,2)
+            child%var%oldvalues2d(2,kindex) =
+     &           child%var%parray3(ir,jr,kr)
+            kindex = kindex + 1
+             enddo
+           enddo
+         enddo       
+C
+      CASE (4)
+          do lr=bounds(4,1),bounds(4,2)
+           do kr=bounds(3,1),bounds(3,2)
+             do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+               do ir=bounds(1,1),bounds(1,2)
+            child%var%oldvalues2d(2,kindex) =
+     &           child%var%parray4(ir,jr,kr,lr)
+            kindex = kindex + 1
+               enddo
+             enddo
+           enddo
+         enddo         
+C
+      CASE (5)
+         do mr=bounds(5,1),bounds(5,2)
+           do lr=bounds(4,1),bounds(4,2)
+            do kr=bounds(3,1),bounds(3,2) 
+              do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+                 do ir=bounds(1,1),bounds(1,2)
+            child%var%oldvalues2d(2,kindex) =
+     &           child%var%parray5(ir,jr,kr,lr,mr)
+            kindex = kindex + 1
+                 enddo
+               enddo
+             enddo
+           enddo
+         enddo   
+C
+      CASE (6)
+        do nr=bounds(6,1),bounds(6,2)
+           do mr=bounds(5,1),bounds(5,2)
+             do lr=bounds(4,1),bounds(4,2)
+               do kr=bounds(3,1),bounds(3,2)
+                do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+                   do ir=bounds(1,1),bounds(1,2)
+            child%var%oldvalues2d(2,kindex) =
+     &           child%var%parray6(ir,jr,kr,lr,mr,nr)
+            kindex = kindex + 1
+                   enddo
+                 enddo
+               enddo
+             enddo
+           enddo
+         enddo       
+      END SELECT
+C
+C                                                  
+      End subroutine saveAfterInterp
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine timeInterpolation
+C     **************************************************************************
+C
+      Subroutine timeInterpolation(child,bounds,kindex,c1t,c2t,nbdim) 
+C
+CCC   Descritpion:
+CCC   Subroutine for a linear time interpolation on the child grid. 
+C
+C     Declarations:
+C
+      
+C
+C     argument
+      TYPE (AGRIF_PVariable) :: child  ! The fine grid variable
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim,2) :: bounds
+      INTEGER                :: kindex ! Index indicating the values of the fine
+                                       ! grid got before and after the space 
+                                       ! interpolation and used for the time 
+                                       ! interpolation
+      REAL                   :: c1t,c2t! coefficients for the time interpolation
+                                       ! (c2t=1-c1t)  
+C
+C     Local aruments      
+      INTEGER :: i
+C     Local scalars
+      INTEGER                      :: ir,jr,kr,lr,mr,nr      
+C
+C
+      
+      SELECT CASE (nbdim)
+      CASE (1)
+
+!CDIR ALTCODE
+         do ir=bounds(1,1),bounds(1,2)
+                child%var%parray1(ir) =
+     &           c2t*child % var % oldvalues2d(1,kindex)   
+     &         + c1t*child % var % oldvalues2d(2,kindex)    
+            kindex = kindex + 1
+         enddo       
+C
+      CASE (2)
+
+        do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+           do ir=bounds(1,1),bounds(1,2)
+                child%var%parray2(ir,jr) =
+     &           c2t*child % var % oldvalues2d(1,kindex)   
+     &         + c1t*child % var % oldvalues2d(2,kindex) 
+            kindex = kindex + 1
+           enddo
+         enddo      
+C
+      CASE (3)
+        do kr=bounds(3,1),bounds(3,2)
+          do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+             do ir=bounds(1,1),bounds(1,2)
+                child%var%parray3(ir,jr,kr) =
+     &           c2t*child % var % oldvalues2d(1,kindex)   
+     &         + c1t*child % var % oldvalues2d(2,kindex) 
+            kindex = kindex + 1
+             enddo
+           enddo
+         enddo       
+C
+      CASE (4)
+          do lr=bounds(4,1),bounds(4,2)
+           do kr=bounds(3,1),bounds(3,2)
+             do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+               do ir=bounds(1,1),bounds(1,2)
+                child%var%parray4(ir,jr,kr,lr) =
+     &           c2t*child % var % oldvalues2d(1,kindex)   
+     &         + c1t*child % var % oldvalues2d(2,kindex) 
+            kindex = kindex + 1
+               enddo
+             enddo
+           enddo
+         enddo         
+C
+      CASE (5)
+         do mr=bounds(5,1),bounds(5,2)
+           do lr=bounds(4,1),bounds(4,2)
+            do kr=bounds(3,1),bounds(3,2) 
+              do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+                 do ir=bounds(1,1),bounds(1,2)
+                child%var%parray5(ir,jr,kr,lr,mr) =
+     &           c2t*child % var % oldvalues2d(1,kindex)   
+     &         + c1t*child % var % oldvalues2d(2,kindex) 
+            kindex = kindex + 1
+                 enddo
+               enddo
+             enddo
+           enddo
+         enddo   
+C
+      CASE (6)
+        do nr=bounds(6,1),bounds(6,2)
+           do mr=bounds(5,1),bounds(5,2)
+             do lr=bounds(4,1),bounds(4,2)
+               do kr=bounds(3,1),bounds(3,2)
+                do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+                   do ir=bounds(1,1),bounds(1,2)
+                child%var%parray6(ir,jr,kr,lr,mr,nr) =
+     &           c2t*child % var % oldvalues2d(1,kindex)   
+     &         + c1t*child % var % oldvalues2d(2,kindex) 
+            kindex = kindex + 1
+                   enddo
+                 enddo
+               enddo
+             enddo
+           enddo
+         enddo       
+      END SELECT
+                                                   
+C
+C
+      End subroutine timeInterpolation      
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Checksize
+C     **************************************************************************
+C
+      Subroutine Agrif_Checksize(child,newsize)
+C
+CCC   Descritpion:
+CCC   Subroutine used in the saveAfterInterp procedure to allocate the 
+CCC   oldvalues2d array. 
+C
+C     Declarations:
+C
+      
+C      
+C     TYPE argument
+      TYPE (AGRIF_PVariable) :: child  ! The fine grid variable
+C 
+C     Scalar arguments
+      INTEGER :: newsize               ! Size of the domains where the boundary 
+                                       ! conditions are calculated  
+C
+C     Local arrays
+      REAL, DIMENSION(:,:), Allocatable :: tempoldvalues ! Temporary array
+C                
+C
+      if (.NOT. associated(child % var % oldvalues2d)) then
+C
+          allocate(child % var % oldvalues2d(2,newsize))
+C  
+          child % var % oldvalues2d=0.
+C
+        else
+C
+          if (SIZE(child % var % oldvalues2d,2) < newsize) then   
+C
+              allocate(tempoldvalues(2,SIZE(child % var %
+     &                                    oldvalues2d,2)))
+C
+              tempoldvalues = child % var % oldvalues2d
+C
+              deallocate(child % var % oldvalues2d)
+C
+              allocate(child % var % oldvalues2d(2,newsize))
+C            
+              child%var%oldvalues2d=0.
+C
+              child % var % oldvalues2d(:,1:SIZE(tempoldvalues,2)) = 
+     &        tempoldvalues(:,:)
+C
+              deallocate(tempoldvalues)
+C
+          endif 
+C
+      endif                                                    
+C
+C
+      End  Subroutine Agrif_Checksize
+C
+C
+C
+C      
+      End Module AGRIF_boundary
+
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbcfunction.F
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbcfunction.F	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbcfunction.F	(revision 8201)
@@ -0,0 +1,2448 @@
+!
+! $Id: modbcfunction.F 2715 2011-03-30 15:58:35Z rblod $
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module AGRIF_bcfunction
+C
+C 
+      Module  Agrif_bcfunction
+CCC   Description:
+CCC   
+C
+C     Modules used:
+C  
+      Use Agrif_Boundary
+      Use Agrif_Update
+      Use Agrif_fluxmod
+      Use Agrif_Save
+C             
+      IMPLICIT NONE
+C
+      interface Agrif_Bc_variable
+          module procedure Agrif_Bc_variable0d,
+     &                     Agrif_Bc_variable1d,
+     &                     Agrif_Bc_variable2d,
+     &                     Agrif_Bc_variable3d,
+     &                     Agrif_Bc_variable4d,
+     &                     Agrif_Bc_variable5d
+      end interface       
+C
+      interface Agrif_Set_Parent
+          module procedure Agrif_Set_Parent_int,
+     &                     Agrif_Set_Parent_real
+      end interface       
+C
+      interface Agrif_Interp_variable
+          module procedure Agrif_Interp_var0d,
+     &                     Agrif_Interp_var1d,
+     &                     Agrif_Interp_var2d,
+     &                     Agrif_Interp_var3d,
+     &                     Agrif_Interp_var4d,
+     &                     Agrif_Interp_var5d
+      end interface       
+C
+      interface Agrif_Init_variable
+          module procedure Agrif_Init_variable0d,
+     &                     Agrif_Init_variable1d,
+     &                     Agrif_Init_variable2d,
+     &                     Agrif_Init_variable3d,
+     &                     Agrif_Init_variable4d
+      end interface       
+C
+      interface Agrif_update_variable
+          module procedure Agrif_update_var0d,
+     &                     Agrif_update_var1d,
+     &                     Agrif_update_var2d,
+     &                     Agrif_update_var3d,
+     &                     Agrif_update_var4d,
+     &                     Agrif_update_var5d
+      end interface       
+      
+      interface Agrif_Save_Forrestore
+         module procedure Agrif_Save_Forrestore0d,    
+     &                    Agrif_Save_Forrestore2d,    
+     &                    Agrif_Save_Forrestore3d,    
+     &                    Agrif_Save_Forrestore4d
+      end interface
+C
+      Contains 
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Set_type
+C     **************************************************************************
+C 
+      Subroutine Agrif_Set_type(tabvarsindic,posvar,point)
+C
+CCC   Description:
+CCC   To set the TYPE of the variable.
+C
+C     Modules used:
+C      
+
+C
+C     Declarations:
+C      
+C
+C
+C     Arguments      
+C
+      INTEGER, DIMENSION(:) :: posvar
+      INTEGER, DIMENSION(:) :: point
+C
+      INTEGER :: tabvarsindic ! indice of the variable in tabvars
+      INTEGER :: dimensio ! DIMENSION of the variable
+      INTEGER :: i
+C
+C
+C     Begin 
+C
+      dimensio = Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim
+C
+      if (.not.associated(Agrif_Mygrid % tabvars(tabvarsindic)
+     &                                 %var % posvar)) then
+      Allocate( 
+     & Agrif_Mygrid % tabvars(tabvarsindic)%var % posvar(dimensio))
+      endif 
+            
+      do i = 1 , dimensio
+         Agrif_Mygrid % tabvars(tabvarsindic) %var % posvar(i)
+     &                       = posvar(i)
+         Agrif_Mygrid % tabvars(tabvarsindic) %var % point(i) 
+     &                       = point(i)
+      enddo
+C
+C
+      End Subroutine Agrif_Set_type
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Set_parent_int
+C     **************************************************************************
+C 
+      Subroutine Agrif_Set_parent_int(tabvarsindic,value)
+C
+CCC   Description:
+CCC   To set the TYPE of the variable.
+C
+C     Modules used:
+C      
+
+C
+C     Declarations:
+C      
+C
+C
+C     Arguments      
+C
+      INTEGER :: tabvarsindic ! indice of the variable in tabvars
+      INTEGER :: Value
+C
+C     Begin 
+C
+      Agrif_Curgrid % parent % tabvars(tabvarsindic) % 
+     &         var % iarray0 = value
+C
+C
+      End Subroutine Agrif_Set_parent_int
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Set_parent_real
+C     **************************************************************************
+C 
+      Subroutine Agrif_Set_parent_real(tabvarsindic,value)
+C
+CCC   Description:
+CCC   To set the TYPE of the variable.
+C
+C     Modules used:
+C      
+
+C
+C     Declarations:
+C      
+C
+C
+C     Arguments      
+C
+      INTEGER :: tabvarsindic ! indice of the variable in tabvars
+      REAL :: Value
+C
+C     Begin 
+C
+      Agrif_Curgrid % parent % tabvars(tabvarsindic) % 
+     &          var % array0 = value
+C
+C
+      End Subroutine Agrif_Set_parent_real
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Set_raf
+C     **************************************************************************
+C 
+      Subroutine Agrif_Set_raf(tabvarsindic,tabraf)
+C
+CCC   Description:
+CCC   Attention tabraf est de taille trois si on ne raffine pas suivant z la
+CCC             troisieme entree du tableau tabraf est 'N'
+C
+C     Modules used:
+C      
+
+C
+C     Declarations:
+C      
+C     Arguments      
+C
+      CHARACTER(*) ,DIMENSION(:) :: tabraf
+C
+      INTEGER :: tabvarsindic ! indice of the variable in tabvars
+      INTEGER :: dimensio ! DIMENSION of the variable
+      INTEGER :: i
+C
+C
+C     Begin 
+C
+      dimensio = Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim
+C        
+      if (.not.associated(Agrif_Mygrid % tabvars(tabvarsindic)
+     &                                 %var % interptab)) then 
+      Allocate(
+     & Agrif_Mygrid % tabvars(tabvarsindic)%var% interptab(dimensio))
+      endif
+
+      do i = 1 , dimensio
+         Agrif_Mygrid % tabvars(tabvarsindic) %var % interptab(i) 
+     &                 = TRIM(tabraf(i))
+      enddo
+C
+      End Subroutine Agrif_Set_raf
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Set_bc
+C     **************************************************************************
+C 
+      Subroutine Agrif_Set_bc(tabvarsindic,point,
+     &          Interpolationshouldbemade)
+C
+CCC   Description:
+CCC
+C
+C     Modules used:
+C      
+
+C
+C     Declarations:
+C      
+C     Arguments      
+C
+      INTEGER, DIMENSION(2) :: point
+      LOGICAL, OPTIONAL :: Interpolationshouldbemade
+C
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+      TYPE(Agrif_PVariable),Pointer ::tabvars
+      
+    
+C
+C
+C     Begin 
+C
+C     
+
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      endif  
+      
+      if (Agrif_Curgrid % fixedrank .NE. 0) then  
+       IF (.Not.Associated(tabvars%var% interpIndex)) THEN
+        Allocate(tabvars%var % interpIndex)
+          tabvars%var % interpIndex = -1
+
+        Allocate(tabvars%var % oldvalues2D(2,1))
+          tabvars%var % oldvalues2D = 0. 
+       ENDIF      
+       if ( PRESENT(Interpolationshouldbemade) ) then
+         tabvars%var %
+     &     Interpolationshouldbemade = Interpolationshouldbemade
+       endif
+
+      endif
+C
+      tabvars%var % bcinf = point(1)
+      tabvars%var % bcsup = point(2)
+C
+      End Subroutine Agrif_Set_bc
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Set_interp
+C     **************************************************************************
+C 
+      Subroutine Agrif_Set_interp(tabvarsindic,interp,interp1,interp2,
+     &                interp3)
+C
+CCC   Description:
+C
+C     Declarations:
+C      
+C     Arguments      
+C
+      INTEGER, OPTIONAL      :: interp,interp1,interp2,interp3
+C
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+      TYPE(Agrif_PVariable),Pointer ::tabvars
+      
+    
+C
+C
+C     Begin 
+C
+C     
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Mygrid % tabvars(indic)
+      endif      
+C
+C     Begin 
+C
+      tabvars % var % Typeinterp = 
+     &    Agrif_Constant
+      IF (present(interp)) THEN
+      tabvars % var % Typeinterp = 
+     &           interp
+      ENDIF
+      IF (present(interp1)) THEN
+      tabvars % var % Typeinterp(1) = 
+     &           interp1
+      ENDIF
+      IF (present(interp2)) THEN
+      tabvars % var % Typeinterp(2) = 
+     &           interp2
+      ENDIF
+      IF (present(interp3)) THEN
+      tabvars % var % Typeinterp(3) = 
+     &           interp3
+      ENDIF
+C
+      End Subroutine Agrif_Set_interp
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Set_bcinterp
+C     **************************************************************************
+C 
+      Subroutine Agrif_Set_bcinterp(tabvarsindic,interp,interp1,
+     &      interp2,interp3,interp11,interp12,interp21,interp22)
+C
+CCC   Description:
+
+C
+C     Modules used:
+C      
+
+C
+C     Declarations:
+C      
+C     Arguments      
+C
+      INTEGER, OPTIONAL      :: interp,interp1,interp2,interp3
+      INTEGER, OPTIONAL      :: interp11,interp12,interp21,interp22
+C
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+      TYPE(Agrif_PVariable),Pointer ::tabvars
+      
+    
+C
+C
+C     Begin 
+C
+C     
+
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Mygrid % tabvars(indic)
+      endif 
+C
+      tabvars% var % bctypeinterp = 
+     &           Agrif_Constant   
+      IF (present(interp)) THEN
+      tabvars% var % bctypeinterp = 
+     &           interp
+      ENDIF       
+      IF (present(interp1)) THEN
+      tabvars% var % bctypeinterp(1:2,1) = 
+     &           interp1
+      ENDIF       
+      IF (present(interp11)) THEN
+      tabvars% var % bctypeinterp(1,1) = 
+     &           interp11
+      ENDIF
+      IF (present(interp12)) THEN
+      tabvars% var % bctypeinterp(1,2) = 
+     &           interp12
+      ENDIF          
+      IF (present(interp2)) THEN
+      tabvars% var % bctypeinterp(1:2,2) = 
+     &           interp2
+      ENDIF
+      IF (present(interp21)) THEN
+      tabvars% var % bctypeinterp(2,1) = 
+     &           interp21
+      ENDIF      
+      IF (present(interp22)) THEN
+      tabvars% var % bctypeinterp(2,2) = 
+     &           interp22
+      ENDIF            
+      IF (present(interp3)) THEN
+      tabvars% var % bctypeinterp(1:2,3) =
+     &           interp3
+      ENDIF
+C
+      End Subroutine Agrif_Set_bcinterp
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Set_Update
+C     **************************************************************************
+C 
+      Subroutine Agrif_Set_Update(tabvarsindic,point)
+C
+CCC   Description:
+CCC
+C
+C     Modules used:
+C      
+
+C
+C     Declarations:
+C      
+C     Arguments      
+C
+      INTEGER, DIMENSION(2) :: point
+C
+      INTEGER :: tabvarsindic ! indice of the variable in tabvars
+C
+C
+C     Begin 
+C
+      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = point(1)
+      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = point(2)
+C
+      End Subroutine Agrif_Set_Update
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Set_UpdateType
+C     **************************************************************************
+C 
+      Subroutine Agrif_Set_UpdateType(tabvarsindic,
+     &                                  update,update1,update2,
+     &                                  update3,update4,update5)
+C
+CCC   Description:
+
+C
+C     Modules used:
+C      
+
+C
+C     Declarations:
+C      
+C     Arguments      
+C
+      INTEGER, OPTIONAL           :: update, update1,
+     &       update2, update3,update4,update5
+C
+      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
+      TYPE(Agrif_PVariable),Pointer :: roottabvars      
+C
+C
+C     Begin 
+
+      indic = tabvarsindic
+
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)      
+      else
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+      
+C
+      roottabvars% var % typeupdate = 
+     &                   Agrif_Update_Copy
+      
+      IF (present(update)) THEN
+        roottabvars% var % typeupdate = 
+     &           update
+      ENDIF
+      IF (present(update1)) THEN
+        roottabvars% var % typeupdate(1) = 
+     &           update1
+      ENDIF  
+      IF (present(update2)) THEN
+        roottabvars% var % typeupdate(2) = 
+     &           update2
+      ENDIF  
+      IF (present(update3)) THEN
+        roottabvars% var % typeupdate(3) = 
+     &           update3
+      ENDIF 
+      IF (present(update4)) THEN
+        roottabvars% var % typeupdate(4) = 
+     &           update4
+      ENDIF       
+      IF (present(update5)) THEN
+        roottabvars% var % typeupdate(5) = 
+     &           update5
+      ENDIF                  
+C
+      End Subroutine Agrif_Set_UpdateType           
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Set_restore
+C     **************************************************************************
+C 
+      Subroutine Agrif_Set_restore(tabvarsindic)
+C
+CCC   Description:
+CCC   
+C
+C     Modules used:
+C      
+
+C
+C     Declarations:
+C      
+C     Arguments      
+C
+      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
+C
+C     Begin 
+C
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif  
+C
+      Agrif_Mygrid%tabvars(indic)%var % restaure = .TRUE.
+C
+      End Subroutine Agrif_Set_restore
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Init_variable0d
+C     **************************************************************************
+      Subroutine Agrif_Init_variable0d(tabvarsindic0,tabvarsindic,
+     &        procname)
+
+      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars
+      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname
+C
+      if (Agrif_Root()) Return
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (present(procname)) then
+      CALL Agrif_Interp_variable(tabvarsindic0,indic,procname)
+      CALL Agrif_Bc_variable(tabvarsindic0,indic,1.,procname)
+      else
+      CALL Agrif_Interp_variable(tabvarsindic0,indic)
+      CALL Agrif_Bc_variable(tabvarsindic0,indic,1.)
+      endif
+
+      End Subroutine Agrif_Init_variable0d
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Init_variable1d
+C     **************************************************************************
+      Subroutine Agrif_Init_variable1d(q,tabvarsindic,procname)
+
+      REAL, DIMENSION(:) :: q
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname
+
+C
+      if (Agrif_Root()) Return
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif      
+C
+      if (present(procname)) then
+      CALL Agrif_Interp_variable(q,indic,procname)
+      CALL Agrif_Bc_variable(q,indic,1.,procname)
+      else
+      CALL Agrif_Interp_variable(q,indic)
+      CALL Agrif_Bc_variable(q,indic,1.)
+      endif
+
+      End Subroutine Agrif_Init_variable1d
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Init_variable2d
+C     **************************************************************************
+      Subroutine Agrif_Init_variable2d(q,tabvarsindic,procname)
+
+      REAL,  DIMENSION(:,:) :: q
+      INTEGER :: tabvarsindic ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname
+      integer :: indic
+
+C
+      if (Agrif_Root()) Return
+C
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (present(procname)) then
+      CALL Agrif_Interp_variable(q,indic,procname)
+      CALL Agrif_Bc_variable(q,indic,1.,procname)
+      else
+      CALL Agrif_Interp_variable(q,indic)
+      CALL Agrif_Bc_variable(q,indic,1.)
+      endif
+
+
+      End Subroutine Agrif_Init_variable2d
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Init_variable3d
+C     **************************************************************************
+      Subroutine Agrif_Init_variable3d(q,tabvarsindic,procname)
+
+      REAL,  DIMENSION(:,:,:) :: q
+      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname
+C
+      if (Agrif_Root()) Return
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif      
+C
+      if (present(procname)) then
+      CALL Agrif_Interp_variable(q,indic,procname)
+      CALL Agrif_Bc_variable(q,indic,1.,procname)
+      else
+      CALL Agrif_Interp_variable(q,indic)
+      CALL Agrif_Bc_variable(q,indic,1.)
+      endif
+
+C
+      End Subroutine Agrif_Init_variable3d
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Init_variable4d
+C     **************************************************************************
+      Subroutine Agrif_Init_variable4d(q,tabvarsindic,procname)
+
+      REAL,  DIMENSION(:,:,:,:) :: q
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname
+C
+      if (Agrif_Root()) Return
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif       
+C
+      if (present(procname)) then
+      CALL Agrif_Interp_variable(q,indic,procname)
+      CALL Agrif_Bc_variable(q,indic,1.,procname)
+      else
+      CALL Agrif_Interp_variable(q,indic)
+      CALL Agrif_Bc_variable(q,indic,1.)
+      endif
+
+C
+      End Subroutine Agrif_Init_variable4d      
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Bc_variable0d
+C     **************************************************************************
+      Subroutine Agrif_Bc_variable0d(tabvarsindic0,tabvarsindic,
+     &                               calledweight,procname)
+
+      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars
+      INTEGER :: tabvarsindic ! indice of the variable in tabvars
+C        
+      External :: procname
+      Optional ::  procname
+      REAL, OPTIONAL :: calledweight
+      REAL    :: weight
+      LOGICAL :: pweight
+C
+      INTEGER :: dimensio      
+
+      if (Agrif_Root()) Return
+C
+      dimensio =  Agrif_Mygrid % tabvars(tabvarsindic) % var % nbdim    
+C
+      if ( PRESENT(calledweight) ) then
+        weight=calledweight      
+        pweight = .TRUE.
+      else
+        weight = 0.
+        pweight = .FALSE.
+      endif
+C      
+C
+
+      
+      if ( dimensio .EQ. 1 ) Call Agrif_Interp_Bc_1D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array1,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
+     & weight,
+     & pweight)
+C
+      if ( dimensio .EQ. 2 ) then
+      IF (present(procname)) THEN
+      Call Agrif_Interp_Bc_2D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array2,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
+     & weight,pweight,procname)
+      ELSE
+          
+      Call Agrif_Interp_Bc_2D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array2,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
+     & weight,pweight)
+      ENDIF
+      endif
+C
+      if ( dimensio .EQ. 3 ) then
+      IF (present(procname)) THEN
+
+      Call Agrif_Interp_Bc_3D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array3,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
+     & weight,pweight,procname)      
+      ELSE
+      Call Agrif_Interp_Bc_3D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array3,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
+     & weight,pweight)
+      ENDIF
+      endif
+C
+      if ( dimensio .EQ. 4 ) then
+      IF (present(procname)) THEN
+      Call Agrif_Interp_Bc_4D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array4,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
+     & weight,pweight,procname)      
+      ELSE
+      Call Agrif_Interp_Bc_4D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array4,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
+     & weight,pweight)
+      ENDIF
+      endif
+C
+      if ( dimensio .EQ. 5 ) then
+      IF (present(procname)) THEN
+      Call Agrif_Interp_Bc_5D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array5,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
+     & weight,pweight,procname)      
+      ELSE
+      Call Agrif_Interp_Bc_5D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array5,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
+     & weight,pweight)
+      ENDIF
+      endif
+C
+      if ( dimensio .EQ. 6 ) Call Agrif_Interp_Bc_6D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array6,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
+     & weight,
+     & pweight)
+C
+C
+      End Subroutine Agrif_Bc_variable0d
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Bc_variable1d
+C     **************************************************************************
+      Subroutine Agrif_Bc_variable1d(q,tabvarsindic,calledweight,
+     &                               procname)
+
+      REAL   , Dimension(:)          :: q
+      External :: procname
+      Optional ::  procname
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+C        
+      REAL, OPTIONAL :: calledweight
+      REAL    :: weight
+      LOGICAL :: pweight
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars
+C
+C      
+C      
+      If (Agrif_Root()) Return
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif         
+      
+      if ( PRESENT(calledweight) ) then
+        weight=calledweight      
+        pweight = .TRUE.
+      else
+        weight = 0.
+        pweight = .FALSE.
+      endif
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+            
+      IF (present(procname)) THEN
+      Call Agrif_Interp_Bc_1D(
+     & roottabvars % var % bctypeinterp,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % bcinf,
+     & tabvars % var % bcsup,
+     & weight,pweight,procname)      
+      ELSE
+      Call Agrif_Interp_Bc_1D(
+     & roottabvars % var % bctypeinterp,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % bcinf,
+     & tabvars % var % bcsup,
+     & weight,pweight)
+      ENDIF
+      End Subroutine Agrif_Bc_variable1d 
+      
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Bc_variable2d
+C     **************************************************************************
+      Subroutine Agrif_Bc_variable2d(q,tabvarsindic,calledweight,
+     &                               procname)
+
+      REAL   , Dimension(:,:)          :: q
+      External :: procname
+      Optional ::  procname
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+C        
+      REAL, OPTIONAL :: calledweight
+      REAL    :: weight
+      LOGICAL :: pweight
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars
+C
+C      
+C      
+      If (Agrif_Root()) Return
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif       
+      
+      if ( PRESENT(calledweight) ) then
+        weight=calledweight      
+        pweight = .TRUE.
+      else
+        weight = 0.
+        pweight = .FALSE.
+      endif
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+            
+      IF (present(procname)) THEN
+      Call Agrif_Interp_Bc_2D(
+     & roottabvars % var % bctypeinterp,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % bcinf,
+     & tabvars % var % bcsup,
+     & weight,pweight,procname)      
+      ELSE
+      Call Agrif_Interp_Bc_2D(
+     & roottabvars % var % bctypeinterp,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % bcinf,
+     & tabvars % var % bcsup,
+     & weight,pweight)
+      ENDIF
+      End Subroutine Agrif_Bc_variable2d
+            
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Bc_variable3d
+C     **************************************************************************
+      Subroutine Agrif_Bc_variable3d(q,tabvarsindic,calledweight,
+     &                               procname)
+
+      REAL   , Dimension(:,:,:)          :: q
+      External :: procname
+      Optional ::  procname
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+C        
+      REAL, OPTIONAL :: calledweight
+      REAL    :: weight
+      LOGICAL :: pweight
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars
+C
+C      
+C      
+      If (Agrif_Root()) Return
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif       
+      
+      if ( PRESENT(calledweight) ) then
+        weight=calledweight      
+        pweight = .TRUE.
+      else
+        weight = 0.
+        pweight = .FALSE.
+      endif
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+            
+      IF (present(procname)) THEN
+      Call Agrif_Interp_Bc_3D(
+     & roottabvars % var % bctypeinterp,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % bcinf,
+     & tabvars % var % bcsup,
+     & weight,pweight,procname)      
+      ELSE
+      Call Agrif_Interp_Bc_3D(
+     & roottabvars % var % bctypeinterp,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % bcinf,
+     & tabvars % var % bcsup,
+     & weight,pweight)
+      ENDIF
+      End Subroutine Agrif_Bc_variable3d
+      
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Bc_variable4d
+C     **************************************************************************
+      Subroutine Agrif_Bc_variable4d(q,tabvarsindic,calledweight,
+     &                               procname)
+
+      REAL   , Dimension(:,:,:,:)          :: q
+      External :: procname
+      Optional ::  procname
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+C        
+      REAL, OPTIONAL :: calledweight
+      REAL    :: weight
+      LOGICAL :: pweight
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars
+C
+C      
+C      
+      If (Agrif_Root()) Return
+      
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif      
+      
+      if ( PRESENT(calledweight) ) then
+        weight=calledweight      
+        pweight = .TRUE.
+      else
+        weight = 0.
+        pweight = .FALSE.
+      endif
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+            
+      IF (present(procname)) THEN
+      Call Agrif_Interp_Bc_4D(
+     & roottabvars % var % bctypeinterp,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % bcinf,
+     & tabvars % var % bcsup,
+     & weight,pweight,procname)      
+      ELSE
+      Call Agrif_Interp_Bc_4D(
+     & roottabvars % var % bctypeinterp,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % bcinf,
+     & tabvars % var % bcsup,
+     & weight,pweight)
+      ENDIF
+      End Subroutine Agrif_Bc_variable4d
+            
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Bc_variable5d
+C     **************************************************************************
+      Subroutine Agrif_Bc_variable5d(q,tabvarsindic,calledweight,
+     &                               procname)
+
+      REAL   , Dimension(:,:,:,:,:)          :: q
+      External :: procname
+      Optional ::  procname
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+C        
+      REAL, OPTIONAL :: calledweight
+      REAL    :: weight
+      LOGICAL :: pweight
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars
+C
+C      
+C      
+      If (Agrif_Root()) Return
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif      
+      
+      if ( PRESENT(calledweight) ) then
+        weight=calledweight      
+        pweight = .TRUE.
+      else
+        weight = 0.
+        pweight = .FALSE.
+      endif
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+            
+      IF (present(procname)) THEN
+      Call Agrif_Interp_Bc_5d(
+     & roottabvars % var % bctypeinterp,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % bcinf,
+     & tabvars % var % bcsup,
+     & weight,pweight,procname)      
+      ELSE
+      Call Agrif_Interp_Bc_5d(
+     & roottabvars % var % bctypeinterp,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % bcinf,
+     & tabvars % var % bcsup,
+     & weight,pweight)
+      ENDIF
+      End Subroutine Agrif_Bc_variable5d
+      
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_var0D
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_var0d(tabvarsindic0,tabvarsindic,procname)
+
+      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars
+      INTEGER :: tabvarsindic, indic  ! indice of the variable in tabvars
+      INTEGER :: dimensio  ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname
+C      
+      if (Agrif_Root()) Return
+C     
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif       
+C     
+      dimensio = Agrif_Mygrid % tabvars(indic) % var % nbdim 
+C
+      if ( dimensio .EQ. 1 ) then
+       if (present(procname)) then
+       Call Agrif_Interp_1D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname)
+       else
+       Call Agrif_Interp_1D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim)
+       endif
+       endif
+C
+      if ( dimensio .EQ. 2 ) then
+      if (present(procname)) then
+       Call Agrif_Interp_2D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname)
+      else
+       Call Agrif_Interp_2D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim)
+      endif
+      endif
+C
+      if ( dimensio .EQ. 3 ) then
+      if (present(procname)) then
+       Call Agrif_Interp_3D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname)
+      else
+       Call Agrif_Interp_3D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim)
+      endif
+      endif
+C
+      if ( dimensio .EQ. 4 ) then
+      if (present(procname)) then
+       Call Agrif_Interp_4D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname)
+      else
+       Call Agrif_Interp_4D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim)
+      endif
+      endif
+C
+      if ( dimensio .EQ. 5 ) then
+      if (present(procname)) then
+       Call Agrif_Interp_5D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname)
+      else
+       Call Agrif_Interp_5D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim)
+       endif
+       endif
+C
+      if ( dimensio .EQ. 6 ) then
+      if (present(procname)) then
+       Call Agrif_Interp_6D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array6 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname)
+      else
+       Call Agrif_Interp_6D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array6 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim)
+      endif
+      endif
+C
+      Return
+      End Subroutine Agrif_Interp_var0d
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_var1d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_var1d(q,tabvarsindic,procname)
+
+      REAL, DIMENSION(:) :: q
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars      
+C
+      if (Agrif_Root()) Return
+C      
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+      
+      if (present(procname)) then
+      Call Agrif_Interp_1D(
+     & roottabvars % var %  TypeInterp,
+     & parenttabvars,
+     & tabvars,q,
+     & roottabvars % var % restaure,
+     & roottabvars %var % nbdim,procname)
+      else
+      Call Agrif_Interp_1D(
+     & roottabvars % var %  TypeInterp,
+     & parenttabvars,
+     & tabvars,q,
+     & roottabvars % var % restaure,
+     & roottabvars %var % nbdim)
+     
+      endif
+      Return
+      End Subroutine Agrif_Interp_var1d
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_var2d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_var2d(q,tabvarsindic,procname)
+
+      REAL,  DIMENSION(:,:) :: q
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars      
+C
+       if (Agrif_Root()) Return
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      if (tabvars%var%restaure) then
+        if (agrif_curgrid%ngridstep == 0) then
+          call AGRIF_CopyFromold_AllOneVar
+     &            (Agrif_Curgrid,Agrif_OldMygrid,indic)
+        endif
+      endif
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+
+            
+       if (present(procname)) then
+       Call Agrif_Interp_2D(
+     & roottabvars % var %  TypeInterp,
+     & parenttabvars,
+     & tabvars,q,
+     & roottabvars % var % restaure,
+     & roottabvars %var % nbdim,procname)
+       else
+       Call Agrif_Interp_2D(
+     & roottabvars % var %  TypeInterp,
+     & parenttabvars,
+     & tabvars,q,
+     & roottabvars % var % restaure,
+     & roottabvars %var % nbdim)
+     
+      endif 
+      Return
+      End Subroutine Agrif_Interp_var2d
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_var3d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_var3d(q,tabvarsindic,procname)
+
+      REAL,  DIMENSION(:,:,:) :: q
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars      
+C
+      if (Agrif_Root()) Return
+C      
+
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      if (tabvars%var%restaure) then
+        if (agrif_curgrid%ngridstep == 0) then
+          call AGRIF_CopyFromold_AllOneVar
+     &            (Agrif_Curgrid,Agrif_OldMygrid,indic)
+        endif
+      endif      
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+
+      if (present(procname)) then
+      Call Agrif_Interp_3D(
+     & roottabvars % var %  TypeInterp,
+     & parenttabvars,
+     & tabvars,q,
+     & roottabvars % var % restaure,
+     & roottabvars %var % nbdim,procname)
+      else
+      Call Agrif_Interp_3D(
+     & roottabvars % var %  TypeInterp,
+     & parenttabvars,
+     & tabvars,q,
+     & roottabvars % var % restaure,
+     & roottabvars %var % nbdim)
+     
+      endif   
+      Return
+      End Subroutine Agrif_Interp_var3d
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_var4d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_var4d(q,tabvarsindic,procname)
+
+      REAL,  DIMENSION(:,:,:,:) :: q
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars  
+C
+      if (Agrif_Root()) Return
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      if (tabvars%var%restaure) then
+        if (agrif_curgrid%ngridstep == 0) then
+          call AGRIF_CopyFromold_AllOneVar
+     &            (Agrif_Curgrid,Agrif_OldMygrid,indic)
+        endif
+      endif      
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+            
+      if (present(procname)) then
+      Call Agrif_Interp_4D(
+     & roottabvars % var %  TypeInterp,
+     & parenttabvars,
+     & tabvars,q,
+     & roottabvars % var % restaure,
+     & roottabvars %var % nbdim,procname)
+      else
+      Call Agrif_Interp_4D(
+     & roottabvars % var %  TypeInterp,
+     & parenttabvars,
+     & tabvars,q,
+     & roottabvars % var % restaure,
+     & roottabvars %var % nbdim)
+     
+      endif      
+
+      Return
+      End Subroutine Agrif_Interp_var4d     
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_var5d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_var5d(q,tabvarsindic,procname)
+
+      REAL,  DIMENSION(:,:,:,:,:) :: q
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars      
+C
+      if (Agrif_Root()) Return
+C      
+
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+      
+      if (present(procname)) then
+      Call Agrif_Interp_5D(
+     & roottabvars % var %  TypeInterp,
+     & parenttabvars,
+     & tabvars,q,
+     & roottabvars % var % restaure,
+     & roottabvars %var % nbdim,procname)
+      else
+      Call Agrif_Interp_5D(
+     & roottabvars % var %  TypeInterp,
+     & parenttabvars,
+     & tabvars,q,
+     & roottabvars % var % restaure,
+     & roottabvars %var % nbdim)
+     
+      endif
+      Return
+      End Subroutine Agrif_Interp_var5d       
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_update_var0d
+C     **************************************************************************
+C 
+      Subroutine Agrif_update_var0d(tabvarsindic0,tabvarsindic,
+     &                              locupdate,locupdate1,
+     &                  locupdate2,procname)
+
+      INTEGER :: tabvarsindic ! indice of the variable in tabvars
+      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname      
+      INTEGER :: dimensio
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2            
+C
+      dimensio = Agrif_Mygrid % tabvars(tabvarsindic) % var % nbdim 
+C      
+      if (Agrif_Root()) Return
+      
+C     
+      IF (present(locupdate)) THEN
+      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:dimensio)
+     &      = locupdate(1)
+      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:dimensio) 
+     &      = locupdate(2)
+      ELSE
+      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:dimensio) 
+     &      = -99
+      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:dimensio) 
+     &      = -99
+      ENDIF
+      
+      IF (present(locupdate1)) THEN
+      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1) 
+     &      = locupdate1(1)
+      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1) 
+     &      = locupdate1(2)
+      ENDIF  
+      
+      IF (present(locupdate2)) THEN
+      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(2) 
+     &      = locupdate2(1)
+      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(2) 
+     &      = locupdate2(2)
+      ENDIF             
+ 
+      if ( dimensio .EQ. 1 ) then
+      IF (present(procname)) THEN
+      Call Agrif_Update_1D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
+     & procname)
+      ELSE
+      Call Agrif_Update_1D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)      
+      ENDIF
+      endif
+      if ( dimensio .EQ. 2 ) then
+      IF (present(procname)) THEN
+      Call Agrif_Update_2D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
+     & procname)
+      ELSE
+      Call Agrif_Update_2D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)      
+      ENDIF
+      endif
+      if ( dimensio .EQ. 3 ) then
+      IF (present(procname)) THEN
+      Call Agrif_Update_3D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
+     & procname)
+      ELSE
+      Call Agrif_Update_3D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)      
+      ENDIF
+      endif
+      if ( dimensio .EQ. 4 ) then
+      IF (present(procname)) THEN
+      Call Agrif_Update_4D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
+     & procname)
+      ELSE
+      Call Agrif_Update_4D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)      
+      ENDIF
+      endif
+      if ( dimensio .EQ. 5 ) then
+      IF (present(procname)) THEN
+      Call Agrif_Update_5D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
+     & procname)
+      ELSE
+      Call Agrif_Update_5D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)      
+      ENDIF
+      endif
+
+      Return
+      End Subroutine Agrif_update_var0d
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_update_var1d
+C     **************************************************************************
+C 
+      Subroutine Agrif_update_var1d(q,tabvarsindic,locupdate,
+     &  locupdate1,locupdate2,procname)
+
+      REAL,  DIMENSION(:) :: q
+      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname      
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2        
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars   
+C      
+      if (Agrif_Root()) Return
+C     
+
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)      
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+      
+      IF (present(locupdate)) THEN
+      tabvars%var % updateinf(1:1) 
+     &      = locupdate(1)
+      tabvars%var % updatesup(1:1) 
+     &      = locupdate(2)
+      ELSE
+      tabvars%var % updateinf(1:1) 
+     &      = -99
+      tabvars%var % updatesup(1:1) 
+     &      = -99
+      ENDIF
+      
+      IF (present(locupdate1)) THEN
+      tabvars%var % updateinf(1) 
+     &      = locupdate1(1)
+      tabvars%var % updatesup(1) 
+     &      = locupdate1(2)
+      ENDIF  
+      
+      IF (present(locupdate2)) THEN
+      tabvars%var % updateinf(2) 
+     &      = locupdate2(1)
+      tabvars%var % updatesup(2) 
+     &      = locupdate2(2)
+      ENDIF       
+ 
+      IF (present(procname)) THEN
+      Call Agrif_Update_1D(
+     & roottabvars % var % typeupdate,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % updateinf,
+     & tabvars % var % updatesup,
+     & procname)
+      ELSE 
+      Call Agrif_Update_1D(
+     & roottabvars % var % typeupdate,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % updateinf,
+     & tabvars % var % updatesup)       
+      ENDIF
+
+      Return
+      End Subroutine Agrif_update_var1d
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_update_var2d
+C     **************************************************************************
+C 
+      Subroutine Agrif_update_var2d(q,tabvarsindic,locupdate,
+     &  locupdate1,locupdate2,procname)
+
+      REAL,  DIMENSION(:,:) :: q
+      External :: procname
+      Optional ::  procname
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate 
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2        
+      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars       
+C      
+      IF (Agrif_Root()) RETURN
+      
+C 
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)      
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+      
+      IF (present(locupdate)) THEN
+      tabvars%var % updateinf(1:2) 
+     &      = locupdate(1)
+      tabvars%var % updatesup(1:2) 
+     &      = locupdate(2)
+      ELSE
+      tabvars%var % updateinf(1:2) 
+     &      = -99
+      tabvars%var % updatesup(1:2) 
+     &      = -99
+      ENDIF
+      
+      IF (present(locupdate1)) THEN
+      tabvars%var % updateinf(1) 
+     &      = locupdate1(1)
+      tabvars%var % updatesup(1) 
+     &      = locupdate1(2)
+      ENDIF  
+      
+      IF (present(locupdate2)) THEN
+      tabvars%var % updateinf(2) 
+     &      = locupdate2(1)
+      tabvars%var % updatesup(2) 
+     &      = locupdate2(2)
+      ENDIF
+ 
+      IF (present(procname)) THEN
+      Call Agrif_Update_2D(
+     & roottabvars % var % typeupdate,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % updateinf,
+     & tabvars % var % updatesup,
+     & procname)
+      ELSE 
+      Call Agrif_Update_2D(
+     & roottabvars % var % typeupdate,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % updateinf,
+     & tabvars % var % updatesup)       
+      ENDIF
+
+      Return
+      End Subroutine Agrif_update_var2d
+C 
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_update_var3d
+C     **************************************************************************
+C 
+      Subroutine Agrif_update_var3d(q,tabvarsindic,locupdate,
+     &  locupdate1,locupdate2,procname)
+
+      REAL,  DIMENSION(:,:,:) :: q
+      External :: procname
+      Optional ::  procname
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2        
+      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars       
+C      
+      IF (Agrif_Root()) RETURN 
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)      
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+      
+      IF (present(locupdate)) THEN
+      tabvars%var % updateinf(1:3) 
+     &      = locupdate(1)
+      tabvars%var % updatesup(1:3) 
+     &      = locupdate(2)
+      ELSE
+      tabvars%var % updateinf(1:3) 
+     &      = -99
+      tabvars%var % updatesup(1:3) 
+     &      = -99
+      ENDIF      
+      
+      IF (present(locupdate1)) THEN
+      tabvars%var % updateinf(1) 
+     &      = locupdate1(1)
+      tabvars%var % updatesup(1) 
+     &      = locupdate1(2)
+      ENDIF  
+      
+      IF (present(locupdate2)) THEN
+      tabvars%var % updateinf(2) 
+     &      = locupdate2(1)
+      tabvars%var % updatesup(2) 
+     &      = locupdate2(2)
+      ENDIF
+
+      IF (present(procname)) THEN
+      Call Agrif_Update_3D(
+     & roottabvars % var % typeupdate,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % updateinf,
+     & tabvars % var % updatesup,
+     & procname)
+      ELSE 
+      Call Agrif_Update_3D(
+     & roottabvars % var % typeupdate,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % updateinf,
+     & tabvars % var % updatesup)       
+      ENDIF
+
+      Return
+      End Subroutine Agrif_update_var3d
+C 
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_update_var4d
+C     **************************************************************************
+C 
+      Subroutine Agrif_update_var4d(q,tabvarsindic,locupdate,
+     &  locupdate1,locupdate2,procname)
+
+      REAL,  DIMENSION(:,:,:,:) :: q
+      External :: procname
+      Optional ::  procname
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2        
+      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars       
+C      
+      IF (Agrif_Root()) RETURN
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)     
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif      
+C      
+      IF (present(locupdate)) THEN
+      tabvars%var % updateinf(1:4) 
+     &      = locupdate(1)
+      tabvars%var % updatesup(1:4) 
+     &      = locupdate(2)
+      ELSE
+      tabvars%var % updateinf(1:4) 
+     &      = -99
+      tabvars%var % updatesup(1:4) 
+     &      = -99
+      ENDIF
+      
+      IF (present(locupdate1)) THEN
+      tabvars%var % updateinf(1) 
+     &      = locupdate1(1)
+      tabvars%var % updatesup(1) 
+     &      = locupdate1(2)
+      ENDIF  
+      
+      IF (present(locupdate2)) THEN
+      tabvars%var % updateinf(2) 
+     &      = locupdate2(1)
+      tabvars%var % updatesup(2) 
+     &      = locupdate2(2)
+      ENDIF
+
+      IF (present(procname)) THEN
+      Call Agrif_Update_4D(
+     & roottabvars % var % typeupdate,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % updateinf,
+     & tabvars % var % updatesup,
+     & procname)
+      ELSE 
+      Call Agrif_Update_4D(
+     & roottabvars % var % typeupdate,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % updateinf,
+     & tabvars % var % updatesup)       
+      ENDIF
+
+      Return
+      End Subroutine Agrif_update_var4d  
+C 
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_update_var5d
+C     **************************************************************************
+C 
+      Subroutine Agrif_update_var5d(q,tabvarsindic,locupdate,
+     &  locupdate1,locupdate2,procname)
+
+      REAL,  DIMENSION(:,:,:,:,:) :: q
+      External :: procname
+      Optional ::  procname
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2        
+      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars       
+C
+      IF (Agrif_Root()) RETURN
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)      
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+       
+      IF (present(locupdate)) THEN
+      tabvars%var % updateinf(1:5) 
+     &      = locupdate(1)
+      tabvars%var % updatesup(1:5) 
+     &      = locupdate(2)
+      ELSE
+      tabvars%var % updateinf(1:5) 
+     &      = -99
+      tabvars%var % updatesup(1:5) 
+     &      = -99
+      ENDIF
+      
+      IF (present(locupdate1)) THEN
+      tabvars%var % updateinf(1) 
+     &      = locupdate1(1)
+      tabvars%var % updatesup(1) 
+     &      = locupdate1(2)
+      ENDIF  
+      
+      IF (present(locupdate2)) THEN
+      tabvars%var % updateinf(2) 
+     &      = locupdate2(1)
+      tabvars%var % updatesup(2) 
+     &      = locupdate2(2)
+      ENDIF
+
+      IF (present(procname)) THEN
+      Call Agrif_Update_5D(
+     & roottabvars % var % typeupdate,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % updateinf,
+     & tabvars % var % updatesup,
+     & procname)
+      ELSE 
+      Call Agrif_Update_5D(
+     & roottabvars % var % typeupdate,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % updateinf,
+     & tabvars % var % updatesup)       
+      ENDIF
+
+      Return
+      End Subroutine Agrif_update_var5d  
+          
+      Subroutine Agrif_Declare_Flux(fluxname,profilename) 
+      character*(*) :: fluxname, profilename
+      Type(Agrif_Flux), pointer :: newflux
+      Type(Agrif_Profile), pointer  :: parcours
+      logical :: foundprofile
+      integer :: i,j,n
+            
+      foundprofile = .FALSE.
+      parcours => Agrif_Myprofiles
+      
+      Do While (Associated(parcours))
+         IF (parcours % profilename == profilename) THEN
+           foundprofile = .TRUE.
+           EXIT
+         ENDIF
+         parcours => parcours%nextprofile
+      End Do      
+      
+      IF (.NOT.foundprofile) THEN
+      write(*,*) 'The profile '''
+     &           //TRIM(profilename)//''' has not been declared'  
+      stop    
+      ENDIF
+      
+      Allocate(Newflux)
+      
+      Newflux % fluxname = fluxname
+      
+      Newflux % profile => parcours
+      
+      Newflux % nextflux => Agrif_Curgrid % fluxes
+      
+      Agrif_Curgrid % fluxes => Newflux
+      
+      End Subroutine Agrif_Declare_Flux  
+       
+      Subroutine Agrif_Save_Flux(fluxname, fluxtab)
+      character*(*) :: fluxname
+      REAL, DIMENSION(:,:) :: fluxtab
+      
+      
+      Type(Agrif_Flux), pointer :: Flux
+      
+      Type(Agrif_pgrid), pointer :: parcours_child
+      
+      Type(Agrif_grid), Pointer :: currentgrid,oldcurgrid
+      
+      IF (.Not.Agrif_Root()) THEN
+      Flux => Agrif_Search_Flux(fluxname)
+
+      IF (.NOT.Flux%fluxallocated) THEN
+        CALL Agrif_AllocateFlux(Flux,fluxtab)
+      ENDIF
+      
+      Call Agrif_Save_Fluxtab(Flux,fluxtab)
+      
+      ENDIF
+      
+      oldcurgrid=> Agrif_Curgrid
+      
+      parcours_child => Agrif_Curgrid%child_grids
+      
+      Do While (Associated(parcours_child))
+        currentgrid => parcours_child%gr
+        Agrif_Curgrid => parcours_child%gr
+        Flux => Agrif_Search_Flux(fluxname)
+        IF (.NOT.Flux%fluxallocated) THEN
+          CALL Agrif_AllocateFlux(Flux,fluxtab)
+        ENDIF        
+        Call Agrif_Save_Fluxtab_child(Flux,fluxtab)
+        parcours_child=> parcours_child%next
+      End Do
+      
+      Agrif_Curgrid=>oldcurgrid
+      
+      End Subroutine Agrif_Save_Flux
+
+      Subroutine Agrif_Cancel_Flux(fluxname)
+      character*(*) :: fluxname
+      
+      Type(Agrif_Flux), pointer :: Flux
+      
+      Flux => Agrif_Search_Flux(fluxname)
+
+      IF (Flux%FluxAllocated) Call Agrif_Cancel_Fluxarray(Flux)
+      
+      End Subroutine Agrif_Cancel_Flux
+ 
+      Subroutine Agrif_Flux_Correction(fluxname, procname)
+      character*(*) :: fluxname
+      external :: procname
+      
+      Type(Agrif_Flux), pointer :: Flux
+      
+      Flux => Agrif_Search_Flux(fluxname)
+      
+      Call Agrif_FluxCorrect(Flux, procname)
+
+      
+      End Subroutine Agrif_Flux_Correction
+
+
+      
+      Subroutine Agrif_Declare_Profile_flux(profilename,posvar,
+     &    firstpoint,raf)
+      character*(*) :: profilename
+      Type(Agrif_Profile), Pointer :: newprofile
+      INTEGER, DIMENSION(:) :: posvar
+      INTEGER, DIMENSION(:) :: firstpoint
+      CHARACTER(*) ,DIMENSION(:) :: raf      
+      INTEGER :: dimensio
+            
+      dimensio = SIZE(posvar)
+C
+C    
+      Allocate(newprofile)
+      Allocate(newprofile%posvar(dimensio))
+      Allocate(newprofile%interptab(dimensio))
+      newprofile%profilename = profilename
+      newprofile%interptab = raf
+      newprofile%nbdim = dimensio
+      newprofile%posvar = posvar
+      newprofile%point(1:dimensio) = firstpoint
+      
+      newprofile % nextprofile => Agrif_myprofiles
+      
+      Agrif_myprofiles => newprofile
+      
+      End Subroutine Agrif_Declare_Profile_flux
+
+      Subroutine Agrif_Save_ForRestore0D(tabvarsindic0,tabvarsindic)
+      integer :: tabvarsindic0, tabvarsindic
+      integer :: dimensio
+              
+      dimensio =  Agrif_Mygrid % tabvars(tabvarsindic0) % var % nbdim
+      
+      select case(dimensio)
+      case(2)
+          call Agrif_Save_ForRestore2D(
+     &      Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2,
+     &      tabvarsindic)
+      case(3)
+          call Agrif_Save_ForRestore3D(
+     &      Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3,
+     &      tabvarsindic)
+      case(4)
+          call Agrif_Save_ForRestore4D(
+     &      Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4,
+     &      tabvarsindic)     
+      end select
+
+      Return
+      End Subroutine Agrif_Save_ForRestore0D 
+      
+    
+      
+      Subroutine Agrif_Save_ForRestore2D(q,tabvarsindic)
+      real,dimension(:,:) :: q
+      integer :: tabvarsindic, indic
+      TYPE(Agrif_PVariable),Pointer ::tabvars, roottabvars    
+ 
+       indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif      
+      if (.not.allocated(tabvars%var%array2)) then      
+      allocate(tabvars%var%array2(tabvars%var%lb(1):tabvars%var%ub(1),
+     &                            tabvars%var%lb(2):tabvars%var%ub(2)))
+      endif
+      tabvars%var%array2 = q
+      roottabvars%var%restaure = .true.
+      
+      Return
+      End Subroutine Agrif_Save_ForRestore2D  
+      
+      Subroutine Agrif_Save_ForRestore3D(q,tabvarsindic)
+      real,dimension(:,:,:) :: q
+      integer :: tabvarsindic, indic
+      TYPE(Agrif_PVariable),Pointer ::tabvars, roottabvars    
+ 
+       indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif      
+
+      if (.not.allocated(tabvars%var%array3)) then
+      allocate(tabvars%var%array3(tabvars%var%lb(1):tabvars%var%ub(1),
+     &                            tabvars%var%lb(2):tabvars%var%ub(2),
+     &                            tabvars%var%lb(3):tabvars%var%ub(3)))
+      endif
+      tabvars%var%array3 = q
+      roottabvars%var%restaure = .true.
+      
+      Return
+      End Subroutine Agrif_Save_ForRestore3D
+      
+      Subroutine Agrif_Save_ForRestore4D(q,tabvarsindic)
+      real,dimension(:,:,:,:) :: q
+      integer :: tabvarsindic, indic
+      TYPE(Agrif_PVariable),Pointer ::tabvars, roottabvars    
+ 
+       indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+
+      if (.not.allocated(tabvars%var%array4)) then         
+      allocate(tabvars%var%array4(tabvars%var%lb(1):tabvars%var%ub(1),
+     &                            tabvars%var%lb(2):tabvars%var%ub(2),
+     &                            tabvars%var%lb(3):tabvars%var%ub(3),
+     &                            tabvars%var%lb(4):tabvars%var%ub(4)))
+      endif
+      tabvars%var%array4 = q
+      roottabvars%var%restaure = .true.
+      
+      Return
+      End Subroutine Agrif_Save_ForRestore4D                   
+C
+      End module Agrif_bcfunction
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcluster.F
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcluster.F	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcluster.F	(revision 8201)
@@ -0,0 +1,1452 @@
+!
+! $Id: modcluster.F 2715 2011-03-30 15:58:35Z rblod $
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module AGRIF_Clustering  
+C
+C
+      Module Agrif_Clustering 
+C
+CCC   Description:
+CCC   Module to create and initialize the grid hierarchy from the 
+CCC   AGRIF_FixedGrids.in file.
+C
+C     Modules used:
+C  
+      Use Agrif_Curgridfunctions 
+      Use Agrif_Init_Vars
+      Use Agrif_Save
+C             
+      IMPLICIT NONE
+C        
+      Contains 
+C     Define procedures contained in this module
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Cluster_All  
+C     **************************************************************************
+C
+      Recursive Subroutine Agrif_Cluster_All(g,coarsegrid)
+C
+CCC   Description:
+CCC   Subroutine for the clustering. A temporary grid hierarchy, pointed by 
+CCC   coarsegrid, is created.
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+C     Pointer arguments    
+      TYPE(AGRIF_grid)     ,pointer   :: g        ! Pointer on the current grid
+      TYPE(AGRIF_rectangle),pointer   :: coarsegrid
+C      
+C     Local pointer         
+      TYPE(AGRIF_lrectangle),pointer  :: parcours 
+      TYPE(AGRIF_grid)      ,pointer  :: newgrid 
+      REAL                            :: g_eps
+      INTEGER                         :: iii
+C      
+      g_eps = huge(1.)
+      do iii = 1 , Agrif_Probdim
+         g_eps = min(g_eps,g%Agrif_d(iii))
+      enddo
+C
+      g_eps = g_eps/100.                  
+C
+C     Necessary condition for clustering 
+      do iii = 1 , Agrif_Probdim
+         if (g%Agrif_d(iii)/Agrif_coeffref(iii).LT.
+     &                   (Agrif_mind(iii)-g_eps)) Return
+      enddo
+C
+      Nullify(coarsegrid%childgrids)
+C
+      Call Agrif_ClusterGridnD(g,coarsegrid) 
+C
+      parcours => coarsegrid % childgrids                   
+C      
+      do while (associated(parcours))
+C      
+C       Newgrid is created. It is a copy of a fine grid created previously by
+C          clustering.      
+        Allocate(newgrid)
+C      
+        Nullify(newgrid%child_grids)
+C
+        do iii = 1 , Agrif_Probdim
+           newgrid % nb(iii) = (parcours % r % imax(iii) - 
+     &                          parcours % r % imin(iii)) *
+     &                          Agrif_Coeffref(iii)
+C        
+           newgrid % Agrif_x(iii) = g%Agrif_x(iii) + 
+     &                         (parcours %r % imin(iii) -1) 
+     &                         *g%Agrif_d(iii)
+C 
+           newgrid % Agrif_d(iii) = g%Agrif_d(iii) / Agrif_Coeffref(iii)
+C
+        enddo
+C
+        if ( Agrif_Probdim .EQ. 1 ) then
+           allocate(newgrid%tabpoint1D(newgrid%nb(1)+1))
+           newgrid%tabpoint1D = 0
+        endif
+C
+        if ( Agrif_Probdim .EQ. 2 ) then
+           allocate(newgrid%tabpoint2D(newgrid%nb(1)+1,
+     &                                 newgrid%nb(2)+1))
+           newgrid%tabpoint2D = 0      
+        endif
+C
+        if ( Agrif_Probdim .EQ. 3 ) then
+           allocate(newgrid%tabpoint3D(newgrid%nb(1)+1,
+     &                                 newgrid%nb(2)+1,
+     &                                 newgrid%nb(3)+1))
+           newgrid%tabpoint3D = 0
+        endif
+C       Points detection on newgrid
+        Call Agrif_TabpointsnD(Agrif_mygrid,newgrid) 
+C
+C       Recursive call to Agrif_Cluster_All            
+        Call Agrif_Cluster_All (newgrid, parcours % r)     
+C
+        parcours => parcours % next 
+C      
+        if ( Agrif_Probdim .EQ. 1 ) Deallocate(newgrid%tabpoint1D)
+        if ( Agrif_Probdim .EQ. 2 ) Deallocate(newgrid%tabpoint2D)
+        if ( Agrif_Probdim .EQ. 3 ) Deallocate(newgrid%tabpoint3D)
+C
+        Deallocate(newgrid)   
+C
+      enddo
+C
+C      
+      End Subroutine Agrif_Cluster_All
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_TabpointsnD
+C     **************************************************************************
+C
+      Recursive Subroutine Agrif_TabpointsnD(g,newgrid)
+C
+CCC   Description:
+CCC   Copy on newgrid of points detected on the grid hierarchy pointed by g.   
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+C     Arguments
+      TYPE(Agrif_Grid),pointer   :: g,newgrid
+C
+C     Local variables      
+      TYPE(Agrif_Pgrid),pointer  :: parcours
+C
+      REAL                  :: g_eps,newgrid_eps,eps
+      REAL   , DIMENSION(3) :: newmin,newmax
+      REAL   , DIMENSION(3) :: gmin,gmax
+      REAL   , DIMENSION(3) :: xmin
+      INTEGER, DIMENSION(3) :: igmin,inewmin
+      INTEGER, DIMENSION(3) :: inewmax
+      INTEGER               :: iii
+      INTEGER               :: i,j,k
+      INTEGER               :: i0,j0,k0
+C
+C     
+      parcours => g % child_grids
+C
+      do While(associated(parcours))
+        Call Agrif_TabpointsnD(parcours%gr,newgrid)
+        parcours => parcours % next
+      enddo      
+C
+      g_eps = 10.
+      newgrid_eps = 10.
+C      
+      do iii = 1 , Agrif_probdim
+         g_eps = min( g_eps , g % Agrif_d(iii) )
+         newgrid_eps = min(newgrid_eps,newgrid%Agrif_d(iii))
+      enddo
+C
+      eps = min(g_eps,newgrid_eps)/100.                  
+C                   
+      do iii = 1 , Agrif_probdim
+         if (newgrid%Agrif_d(iii) .LT. (g%Agrif_d(iii)-eps)) Return
+C                   
+         gmin(iii) = g%Agrif_x(iii)
+         gmax(iii) = g%Agrif_x(iii) + g%nb(iii) * g%Agrif_d(iii)
+C 
+         newmin(iii) = newgrid%Agrif_x(iii)
+         newmax(iii) = newgrid%Agrif_x(iii) + newgrid%nb(iii) *
+     &                 newgrid%Agrif_d(iii)
+C      
+         if (gmax(iii) .LT. newmin(iii)) Return
+C
+         if (gmin(iii) .GT. newmax(iii)) Return
+C           
+         inewmin(iii) = 1 - floor(-(max(gmin(iii),newmin(iii))-
+     &                    newmin(iii))
+     &                   /newgrid%Agrif_d(iii)) 
+C          
+         xmin(iii) = newgrid%Agrif_x(iii) + (inewmin(iii)-1)*
+     &              newgrid%Agrif_d(iii)          
+C        
+         igmin(iii) = 1 + nint((xmin(iii)-gmin(iii))/g%Agrif_d(iii))
+C
+         inewmax(iii) = 1 + int((min(gmax(iii),newmax(iii))-
+     &                  newmin(iii))/newgrid%Agrif_d(iii))
+      enddo
+C                
+      if ( Agrif_probdim .EQ. 1 ) then
+         i0 = igmin(1)
+         do i = inewmin(1),inewmax(1)
+            newgrid%tabpoint1D(i) = max(
+     &                           newgrid%tabpoint1D(i),
+     &                           g%tabpoint1D(i0))
+         enddo
+         i0 = i0 + int(newgrid%Agrif_d(1)/g%Agrif_d(1))
+      endif
+C
+      if ( Agrif_probdim .EQ. 2 ) then
+         i0 = igmin(1)
+         do i = inewmin(1),inewmax(1)
+            j0 = igmin(2)
+            do j = inewmin(2),inewmax(2)
+               newgrid%tabpoint2D(i,j) = max(
+     &                           newgrid%tabpoint2D(i,j),
+     &                           g%tabpoint2D(i0,j0))
+               j0 = j0 + int(newgrid%Agrif_d(2)/g%Agrif_d(2))
+            enddo
+            i0 = i0 + int(newgrid%Agrif_d(1)/g%Agrif_d(1))
+         enddo
+      endif
+C
+      if ( Agrif_probdim .EQ. 3 ) then
+         i0 = igmin(1)
+         do i = inewmin(1),inewmax(1)
+            j0 = igmin(2)
+            do j = inewmin(2),inewmax(2)
+               k0 = igmin(3)
+               do k = inewmin(3),inewmax(3)
+                  newgrid%tabpoint3D(i,j,k) = max(
+     &                           newgrid%tabpoint3D(i,j,k),
+     &                           g%tabpoint3D(i0,j0,k0))
+                  k0 = k0 + int(newgrid%Agrif_d(3)/g%Agrif_d(3))
+               enddo                                        
+               j0 = j0 + int(newgrid%Agrif_d(2)/g%Agrif_d(2))
+            enddo
+            i0 = i0 + int(newgrid%Agrif_d(1)/g%Agrif_d(1))
+         enddo
+      endif
+C
+      Return
+C
+C
+      End Subroutine Agrif_TabpointsnD
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_ClusterGridnD
+C     **************************************************************************
+C      
+      Subroutine Agrif_ClusterGridnD(g,coarsegrid)
+C
+CCC   Description:
+CCC   Clustering on the grid pointed by g.
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+C     Pointer arguments
+      TYPE(AGRIF_grid)     ,pointer  :: g          ! Pointer on the current grid
+      TYPE(AGRIF_rectangle),pointer  :: coarsegrid
+C
+C     Local variables      
+      TYPE(Agrif_rectangle) :: newrect
+      TYPE(Agrif_Variable)  :: newflag
+C
+      INTEGER               :: i,j,k
+      INTEGER ,DIMENSION(3) :: sx
+      INTEGER               :: bufferwidth,flagpoints
+      INTEGER               :: n1,n2,m1,m2,o1,o2
+      INTEGER               :: iii
+C
+C      
+      bufferwidth = int(Agrif_Minwidth/5.)
+C      
+      do iii = 1 , Agrif_probdim
+         sx(iii) = g % nb(iii) + 1
+      enddo
+C                  
+      if ( Agrif_probdim .EQ. 1 ) then
+         allocate(newflag%iarray1(sx(1)))
+         newflag%iarray1 = 0      
+      endif
+      if ( Agrif_probdim .EQ. 2 ) then
+         allocate(newflag%iarray2(sx(1),sx(2)))
+         newflag%iarray2 = 0      
+      endif
+      if ( Agrif_probdim .EQ. 3 ) then
+         allocate(newflag%iarray3(sx(1),sx(2),sx(3)))
+         newflag%iarray3 = 0      
+      endif
+C
+      flagpoints = 0 
+C      
+      if (bufferwidth>0) then 
+C      
+         if ( Agrif_probdim .EQ. 1 ) then
+            do i = bufferwidth,sx(1)-bufferwidth+1      
+               if (g % tabpoint1D(i) .EQ. 1) then
+                  m1 = i - bufferwidth + 1
+                  m2 = i + bufferwidth - 1                  
+                  flagpoints = flagpoints + 1
+                  newflag%iarray1(m1:m2)=1 
+               endif 
+            enddo    
+         endif
+C
+        if ( Agrif_probdim .EQ. 2 ) then
+           do i = bufferwidth,sx(1)-bufferwidth+1      
+               do j = bufferwidth,sx(2)-bufferwidth+1
+                  if (g % tabpoint2D(i,j) .EQ. 1) then
+                     n1 = j - bufferwidth + 1
+                     n2 = j + bufferwidth - 1
+                     m1 = i - bufferwidth + 1
+                     m2 = i + bufferwidth - 1                  
+                     flagpoints = flagpoints + 1
+                     newflag%iarray2(m1:m2,n1:n2)=1 
+                  endif  
+               enddo    
+            enddo
+         endif
+C
+        if ( Agrif_probdim .EQ. 3 ) then
+            do i = bufferwidth,sx(1)-bufferwidth+1      
+               do j = bufferwidth,sx(2)-bufferwidth+1
+                  do k = bufferwidth,sx(3)-bufferwidth+1
+                     if (g % tabpoint3D(i,j,k) .EQ. 1) then
+                        o1 = k - bufferwidth + 1
+                        o2 = k + bufferwidth - 1
+                        n1 = j - bufferwidth + 1
+                        n2 = j + bufferwidth - 1
+                        m1 = i - bufferwidth + 1
+                        m2 = i + bufferwidth - 1                  
+                        flagpoints = flagpoints + 1
+                        newflag%iarray3(m1:m2,n1:n2,o1:o2)=1 
+                     endif 
+                  enddo  
+               enddo    
+            enddo
+        endif
+      else
+          flagpoints = 1       
+C
+          if ( Agrif_probdim .EQ. 1 ) then
+          newflag%iarray1 = g % tabpoint1D
+          endif
+          if ( Agrif_probdim .EQ. 2 ) then
+          newflag%iarray2 = g % tabpoint2D
+          endif
+          if ( Agrif_probdim .EQ. 3 ) then
+          newflag%iarray3 = g % tabpoint3D
+          endif
+      endif
+C       
+      if (flagpoints .EQ. 0) then       
+          if ( Agrif_probdim .EQ. 1 ) deallocate(newflag%iarray1) 
+          if ( Agrif_probdim .EQ. 2 ) deallocate(newflag%iarray2) 
+          if ( Agrif_probdim .EQ. 3 ) deallocate(newflag%iarray3) 
+          Return 
+      endif       
+C      
+      do iii = 1 , Agrif_probdim
+         newrect % imin(iii) = 1
+         newrect % imax(iii) = sx(iii)
+      enddo
+C      
+      Call Agrif_Clusternd(newflag,
+     &                     coarsegrid%childgrids,newrect) 
+C      
+      if ( Agrif_probdim .EQ. 1 ) deallocate(newflag%iarray1)
+      if ( Agrif_probdim .EQ. 2 ) deallocate(newflag%iarray2)
+      if ( Agrif_probdim .EQ. 3 ) deallocate(newflag%iarray3)
+C  
+C    
+      End Subroutine Agrif_ClusterGridnD
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_ClusternD
+C     **************************************************************************
+C
+      Recursive subroutine Agrif_Clusternd(flag,boxlib,oldB) 
+C
+CCC   Description:
+CCC   Clustering on the grid pointed by oldB.
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+C     Arguments  
+      TYPE(Agrif_rectangle) ::  oldB    
+      TYPE(Agrif_Variable)  :: flag
+c      INTEGER,DIMENSION(oldB%imin(1):oldB%imax(1),
+c     &                  oldB%imin(2):oldB%imax(2)) :: flag
+      TYPE(Agrif_lrectangle),pointer :: boxlib      
+C
+C     Local variables      
+      TYPE(Agrif_lrectangle),pointer :: tempbox,parcbox,parcbox2       
+      TYPE(Agrif_rectangle) :: newB,newB2
+      INTEGER :: i,j,k,iii
+      INTEGER,DIMENSION(:),allocatable :: i_sig 
+      INTEGER,DIMENSION(:),allocatable :: j_sig       
+      INTEGER,DIMENSION(:),allocatable :: k_sig       
+      INTEGER,DIMENSION(3) :: ipu,ipl
+      INTEGER,DIMENSION(3) :: istr,islice
+      REAL :: cureff
+      REAL :: neweff
+      INTEGER :: ValMax,ValSum,TailleTab
+      INTEGER :: nbpoints,nbpointsflag  
+      LOGICAL :: test
+C          
+      allocate(i_sig(oldB%imin(1):oldB%imax(1)))
+      if ( Agrif_probdim .GE. 2 ) 
+     & allocate(j_sig(oldB%imin(2):oldB%imax(2)))
+      if ( Agrif_probdim .EQ. 3 ) 
+     & allocate(k_sig(oldB%imin(3):oldB%imax(3)))
+C
+      test = .FALSE.
+      do iii = 1 , Agrif_probdim
+         test = test .OR. ( (oldB%imax(iii)-oldB%imin(iii)+1) 
+     &                    .LT. Agrif_Minwidth)
+      enddo
+      if ( test ) Return
+C     
+      if ( Agrif_probdim .EQ. 1 ) i_sig = flag%iarray1
+      if ( Agrif_probdim .EQ. 2 ) then
+         do i = oldB%imin(1),oldB%imax(1)
+           i_sig(i) = SUM(flag%iarray2(i,
+     &                            oldB%imin(2):oldB%imax(2)))
+         enddo
+         do j = oldB%imin(2),oldB%imax(2)
+           j_sig(j) = SUM(flag%iarray2(
+     &                            oldB%imin(1):oldB%imax(1),j))
+         enddo      
+      endif
+      if ( Agrif_probdim .EQ. 3 ) then
+         do i = oldB%imin(1),oldB%imax(1)
+            i_sig(i) = SUM(flag%iarray3(i,
+     &                            oldB%imin(2):oldB%imax(2),
+     &                            oldB%imin(3):oldB%imax(3)))
+         enddo
+         do j = oldB%imin(2),oldB%imax(2)
+            j_sig(j) = SUM(flag%iarray3(
+     &                          oldB%imin(1):oldB%imax(1),j,
+     &                          oldB%imin(3):oldB%imax(3)))
+         enddo
+         do k = oldB%imin(3),oldB%imax(3)
+            k_sig(k) = SUM(flag%iarray3(
+     &                          oldB%imin(1):oldB%imax(1),
+     &                          oldB%imin(2):oldB%imax(2),k))
+         enddo      
+      endif
+C                    
+      do iii = 1 , Agrif_probdim
+         ipl(iii) = oldB%imin(iii)
+         ipu(iii) = oldB%imax(iii)
+      enddo
+C           
+      Call Agrif_Clusterprune(i_sig,ipl(1),ipu(1)) 
+      if ( Agrif_probdim .GE. 2 ) 
+     &   Call Agrif_Clusterprune(j_sig,ipl(2),ipu(2))      
+      if ( Agrif_probdim .EQ. 3 ) 
+     &   Call Agrif_Clusterprune(k_sig,ipl(3),ipu(3))      
+C     
+      test = .TRUE.
+      do iii = 1 , Agrif_probdim
+         test = test .AND. (ipl(iii).EQ.oldB%imin(iii))
+         test = test .AND. (ipu(iii).EQ.oldB%imax(iii))
+      enddo
+      
+      if (.NOT. test) then 
+          do iii = 1 , Agrif_probdim
+             newB%imin(iii) = ipl(iii)
+             newB%imax(iii) = ipu(iii)
+          enddo
+C        
+          if ( Agrif_probdim .EQ. 1 ) 
+     &       nbpoints = SUM(flag%iarray1(newB%imin(1):newB%imax(1)))   
+          if ( Agrif_probdim .EQ. 2 ) 
+     &       nbpoints = SUM(flag%iarray2(newB%imin(1):newB%imax(1),
+     &                           newB%imin(2):newB%imax(2)))   
+          if ( Agrif_probdim .EQ. 3 ) 
+     &       nbpoints = SUM(flag%iarray3(newB%imin(1):newB%imax(1),
+     &                           newB%imin(2):newB%imax(2),   
+     &                           newB%imin(3):newB%imax(3)))
+C   
+          if ( Agrif_probdim .EQ. 1 ) 
+     &       TailleTab = newB%imax(1)-newB%imin(1)+1
+          if ( Agrif_probdim .EQ. 2 ) 
+     &       TailleTab = (newB%imax(1)-newB%imin(1)+1)*
+     &                   (newB%imax(2)-newB%imin(2)+1)
+          if ( Agrif_probdim .EQ. 3 ) 
+     &       TailleTab = (newB%imax(1)-newB%imin(1)+1)*
+     &                   (newB%imax(2)-newB%imin(2)+1)*
+     &                   (newB%imax(3)-newB%imin(3)+1)
+C
+          neweff = REAL(nbpoints)/TailleTab
+C     
+          if (nbpoints.GT.0) then
+C        
+              if ((neweff .GT .Agrif_efficiency)) then
+                  Call Agrif_Add_Rectangle(newB,boxlib)
+                  Return
+              else
+C            
+                  tempbox => boxlib
+                  newB2 = newB
+                  Call Agrif_Clusternd(flag,
+     &                      boxlib,newB)
+C     
+C                 Compute new efficiency
+C
+                  cureff = neweff
+                  parcbox2 => boxlib
+                  nbpoints = 0
+                  nbpointsflag = 0
+C
+                  do While (associated(parcbox2))
+                    if (associated(parcbox2,tempbox)) Exit
+                    newB = parcbox2%r
+C
+                    if ( Agrif_probdim .EQ. 1 ) Valsum = 
+     &                                 SUM(flag%iarray1(
+     &                                 newB%imin(1):newB%imax(1)))
+                    if ( Agrif_probdim .EQ. 2 ) Valsum = 
+     &                                 SUM(flag%iarray2(
+     &                                 newB%imin(1):newB%imax(1),
+     &                                 newB%imin(2):newB%imax(2)))
+                    if ( Agrif_probdim .EQ. 3 ) Valsum = 
+     &                                 SUM(flag%iarray3(
+     &                                 newB%imin(1):newB%imax(1),
+     &                                 newB%imin(2):newB%imax(2),
+     &                                 newB%imin(3):newB%imax(3)))
+C
+                    nbpointsflag = nbpointsflag + ValSum
+                    if ( Agrif_probdim .EQ. 1 ) 
+     &                 TailleTab = newB%imax(1)-newB%imin(1)+1
+                    if ( Agrif_probdim .EQ. 2 ) 
+     &                 TailleTab = (newB%imax(1)-newB%imin(1)+1)*
+     &                             (newB%imax(2)-newB%imin(2)+1)
+                    if ( Agrif_probdim .EQ. 3 ) 
+     &                 TailleTab = (newB%imax(1)-newB%imin(1)+1)*
+     &                             (newB%imax(2)-newB%imin(2)+1)*
+     &                             (newB%imax(3)-newB%imin(3)+1)
+                    nbpoints = nbpoints + TailleTab
+                    parcbox2 => parcbox2%next  
+                  enddo  
+C coefficient 1.05 avant 1.15 possibilité de laisser choix à l utilisateur
+                  if  (REAL(nbpointsflag)/REAL(nbpoints)
+     &                 .LT.(1.0001*cureff)) then
+                      parcbox2 => boxlib            
+                      do While (associated(parcbox2))
+                        if (associated(parcbox2,tempbox)) Exit
+                        deallocate(parcbox2%r)
+                        parcbox2 => parcbox2%next             
+                      enddo      
+                      boxlib => tempbox
+                      Call Agrif_Add_Rectangle(newB2,boxlib)
+                      Return
+                  endif
+              endif         
+          endif
+          Return
+      endif 
+C       
+      do iii = 1 , Agrif_Probdim
+         istr(iii) = oldB%imax(iii)
+         islice(iii) = oldB%imin(iii)
+      enddo     
+C      
+      Call Agrif_Clusterslice(i_sig,islice(1),istr(1)) 
+      if ( Agrif_probdim .GE. 2 ) 
+     & Call Agrif_Clusterslice(j_sig,islice(2),istr(2)) 
+      if ( Agrif_probdim .EQ. 3 ) 
+     & Call Agrif_Clusterslice(k_sig,islice(3),istr(3)) 
+C      
+      ValSum = 0
+      do iii = 1 , Agrif_Probdim
+         Valsum = valSum + islice(iii)
+      enddo
+C      
+      if ( Valsum .EQ. -Agrif_Probdim ) then 
+          Call Agrif_Add_Rectangle(oldB,boxlib) 
+          Return 
+      endif 
+C       
+      nullify(tempbox)
+      tempbox => boxlib
+      if ( Agrif_probdim .EQ. 1 ) 
+     &      cureff  = oldB%imax(1)-oldB%imin(1)+1
+      if ( Agrif_probdim .EQ. 2 ) 
+     &      cureff  = (oldB%imax(1)-oldB%imin(1)+1)*
+     &                (oldB%imax(2)-oldB%imin(2)+1)
+      if ( Agrif_probdim .EQ. 3 ) 
+     &       cureff = (oldB%imax(1)-oldB%imin(1)+1)*
+     &                (oldB%imax(2)-oldB%imin(2)+1)*
+     &                (oldB%imax(3)-oldB%imin(3)+1)
+      Nullify(parcbox)
+C 
+      do iii = 1 , Agrif_Probdim
+          newB%imax(iii) = oldB%imax(iii)            
+          newB%imin(iii) = oldB%imin(iii)
+      enddo     
+C
+      ValMax = 0
+      do iii = 1 , Agrif_Probdim
+         ValMax = Max(ValMax,istr(iii))
+      enddo
+C
+      if (istr(1) .EQ. ValMax ) then
+          newB%imax(1) = islice(1)
+          Call Agrif_Add_Rectangle(newB,parcbox)                   
+          newB%imin(1) = islice(1)+1
+          newB%imax(1) = oldB%imax(1)
+          Call Agrif_Add_Rectangle(newB,parcbox)
+      elseif ( Agrif_probdim .GE. 2 ) then
+         if (istr(2) .EQ. ValMax ) then
+            newB%imax(2) = islice(2)
+            Call Agrif_Add_Rectangle(newB,parcbox)
+            newB%imin(2) = islice(2)+1
+            newB%imax(2) = oldB%imax(2)
+            Call Agrif_Add_Rectangle(newB,parcbox)
+         elseif ( Agrif_probdim .EQ. 3 ) then
+            newB%imax(3) = islice(3)
+            Call Agrif_Add_Rectangle(newB,parcbox)
+            newB%imin(3) = islice(3)+1
+            newB%imax(3) = oldB%imax(3)
+            Call Agrif_Add_Rectangle(newB,parcbox)
+         endif
+      endif
+C      
+      do While (associated(parcbox))
+        newB = parcbox%r            
+C
+        if ( Agrif_probdim .EQ. 1 ) nbpoints = 
+     &                                 SUM(flag%iarray1(
+     &                                 newB%imin(1):newB%imax(1)))
+        if ( Agrif_probdim .EQ. 2 ) nbpoints = 
+     &                                 SUM(flag%iarray2(
+     &                                 newB%imin(1):newB%imax(1),
+     &                                 newB%imin(2):newB%imax(2)))
+        if ( Agrif_probdim .EQ. 3 ) nbpoints = 
+     &                                 SUM(flag%iarray3(
+     &                                 newB%imin(1):newB%imax(1),
+     &                                 newB%imin(2):newB%imax(2),
+     &                                 newB%imin(3):newB%imax(3)))
+C      
+       if ( Agrif_probdim .EQ. 1 ) 
+     &                 TailleTab = newB%imax(1)-newB%imin(1)+1
+       if ( Agrif_probdim .EQ. 2 ) 
+     &                 TailleTab = (newB%imax(1)-newB%imin(1)+1)*
+     &                             (newB%imax(2)-newB%imin(2)+1)
+       if ( Agrif_probdim .EQ. 3 ) 
+     &                 TailleTab = (newB%imax(1)-newB%imin(1)+1)*
+     &                             (newB%imax(2)-newB%imin(2)+1)*
+     &                             (newB%imax(3)-newB%imin(3)+1)
+
+        neweff = REAL(nbpoints) / TailleTab
+C     
+        if (nbpoints .GT. 0) then
+C      
+            if ((neweff .GT .Agrif_efficiency)) then
+                Call Agrif_Add_Rectangle(newB,boxlib)
+            else
+                tempbox => boxlib
+                newB2 = newB
+                Call Agrif_Clusternd(flag,
+     &                      boxlib,newB)
+C
+C               Compute new efficiency
+C
+                cureff = neweff
+                parcbox2 => boxlib
+                nbpoints = 0
+                nbpointsflag = 0
+C
+                do While (associated(parcbox2))
+                  if (associated(parcbox2,tempbox)) Exit
+                  newB = parcbox2%r
+C
+                  if ( Agrif_probdim .EQ. 1 ) ValSum = 
+     &                                 SUM(flag%iarray1(
+     &                                 newB%imin(1):newB%imax(1)))
+                  if ( Agrif_probdim .EQ. 2 ) ValSum = 
+     &                                 SUM(flag%iarray2(
+     &                                 newB%imin(1):newB%imax(1),
+     &                                 newB%imin(2):newB%imax(2)))
+                  if ( Agrif_probdim .EQ. 3 ) ValSum = 
+     &                                 SUM(flag%iarray3(
+     &                                 newB%imin(1):newB%imax(1),
+     &                                 newB%imin(2):newB%imax(2),
+     &                                 newB%imin(3):newB%imax(3)))
+C
+                  nbpointsflag = nbpointsflag + ValSum
+C
+                    if ( Agrif_probdim .EQ. 1 ) 
+     &                 TailleTab = newB%imax(1)-newB%imin(1)+1
+                    if ( Agrif_probdim .EQ. 2 ) 
+     &                 TailleTab = (newB%imax(1)-newB%imin(1)+1)*
+     &                             (newB%imax(2)-newB%imin(2)+1)
+                    if ( Agrif_probdim .EQ. 3 ) 
+     &                 TailleTab = (newB%imax(1)-newB%imin(1)+1)*
+     &                             (newB%imax(2)-newB%imin(2)+1)*
+     &                             (newB%imax(3)-newB%imin(3)+1)
+
+                  nbpoints = nbpoints + TailleTab
+C              
+                  parcbox2 => parcbox2%next  
+                enddo   
+C            
+                if  (REAL(nbpointsflag)/REAL(nbpoints)
+     &               .LT.(1.15*cureff)) then
+                    parcbox2 => boxlib            
+                    do While (associated(parcbox2))
+                      if (associated(parcbox2,tempbox)) Exit
+                      deallocate(parcbox2%r)
+                      parcbox2 => parcbox2%next             
+                    enddo
+                    boxlib => tempbox
+                    Call Agrif_Add_Rectangle(newB2,boxlib)
+                endif
+            endif
+        endif
+        parcbox => parcbox%next
+      enddo
+C      
+C      
+      Return
+C      
+      End Subroutine Agrif_Clusternd 
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Clusterslice
+C     **************************************************************************
+C                           
+      Subroutine Agrif_Clusterslice(sig,slice,str) 
+C
+C
+CCC   Description:
+CCC   
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+C     Arguments 
+      INTEGER                      :: slice,str
+      INTEGER,DIMENSION(slice:str) :: sig 
+C
+C     Local variables      
+      INTEGER                      :: ideb,ifin
+      INTEGER                      :: i,t,a,di,ts 
+      INTEGER,DIMENSION(slice:str) :: lap 
+C
+C    
+      ideb = slice
+      ifin = str
+C    
+      if (SIZE(sig) <= 2*Agrif_Minwidth) then
+          str = -1 
+          slice = -1 
+          Return
+      endif
+C      
+      t = -1 
+      a = -1 
+C
+      do i = ideb+Agrif_Minwidth-1,ifin-Agrif_Minwidth
+          if (sig(i) .EQ. 0) then
+              if ((i-ideb) < (ifin-i)) then
+                  di = i - ideb
+                else 
+                  di = ifin - i 
+              endif
+C
+              if (di > t) then
+                a = i 
+                t = di 
+              endif
+         endif
+      enddo
+C      
+      if (a .NE. (-1)) then
+          slice = a 
+          str = t 
+          Return
+      endif
+C      
+      t = -1 
+      a = -1 
+C      
+      do i = ideb+1,ifin-1 
+        lap(i) = sig(i+1) + sig(i-1) - 2*sig(i) 
+      enddo
+C      
+      do i = ideb + Agrif_Minwidth-1,ifin-Agrif_Minwidth
+        if ((lap(i+1)*lap(i)) .LE. 0) then
+            ts = ABS(lap(i+1) - lap(i)) 
+            if (ts > t) then
+                t = ts 
+                a = i
+            endif
+       endif
+      enddo
+C      
+      if (a .EQ. (ideb + Agrif_Minwidth - 1)) then
+          a = -1
+          t = -1
+      endif
+C      
+      slice = a 
+      str = t 
+C
+C      
+      End Subroutine Agrif_Clusterslice       
+C
+C
+C    
+C     **************************************************************************
+CCC   Subroutine Agrif_Clusterprune
+C     **************************************************************************
+C      
+      Subroutine Agrif_Clusterprune(sig,pl,pu) 
+C
+C
+CCC   Description:
+CCC   
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+C     Arguments
+      INTEGER                  :: pl,pu 
+      INTEGER,DIMENSION(pl:pu) :: sig
+C
+C     Local variables      
+      INTEGER :: ideb,ifin       
+      INTEGER :: diff,addl,addu,udist,ldist  
+C
+C      
+      ideb = pl
+      ifin = pu
+C      
+      if (SIZE(sig) <= Agrif_Minwidth) then
+          return 
+      endif 
+C       
+      do While ((sig(pl) .EQ. 0) .AND. (pl < ifin)) 
+        pl = pl + 1 
+      enddo 
+C       
+      do While ((sig(pu) .EQ. 0) .AND. (pu > ideb)) 
+        pu = pu - 1 
+      enddo 
+C       
+      if ((pu-pl) < Agrif_Minwidth) then
+          diff = Agrif_Minwidth - (pu - pl + 1) 
+          udist = ifin - pu 
+          ldist = pl - ideb
+          addl = diff / 2 
+          addu = diff - addl 
+          if (addu > udist) then
+              addu = udist 
+              addl = diff - addu 
+          endif
+C         
+          if (addl > ldist) then
+              addl = ldist 
+              addu = diff - addl
+          endif
+C         
+          pu = pu + addu 
+          pl = pl - addl         
+C      
+      endif 
+C       
+C
+      End Subroutine Agrif_Clusterprune
+C
+C
+C              
+C     **************************************************************************
+CCC   Subroutine Agrif_Add_Rectangle 
+C     **************************************************************************
+C        
+      Subroutine Agrif_Add_Rectangle(R,LR)
+C
+CCC   Description:
+CCC   Subroutine to add the Agrif_Rectangle R in a list managed by LR.
+C
+C     Declarations:
+C
+C     Arguments               
+      TYPE(AGRIF_rectangle)           :: R  
+      TYPE(AGRIF_lrectangle), Pointer :: LR
+C
+C     Local variable        
+      TYPE(AGRIF_lrectangle), Pointer :: newrect  
+C
+      INTEGER                         :: iii 
+C
+C        
+      allocate(newrect)
+      allocate(newrect % r)
+C
+      newrect % r = R
+C      
+      do iii = 1 , Agrif_Probdim
+         newrect % r % spaceref(iii) = Agrif_Coeffref(iii)
+         newrect % r % timeref(iii) = Agrif_Coeffreft(iii)
+      enddo
+C              
+      newrect % r % number = -1            
+      Nullify(newrect % r % childgrids)
+      newrect % next => LR  
+      LR => newrect  
+C
+C      
+      End Subroutine Agrif_Add_Rectangle   
+C  
+C
+C  
+C     **************************************************************************
+CCC   Subroutine Agrif_Read_Fix_Grd  
+C     **************************************************************************
+C      
+      Recursive Subroutine Agrif_Read_Fix_Grd(coarsegrid,j,nunit)
+C
+CCC   Description:
+CCC   Subroutine to create the grid hierarchy from the reading of the 
+CCC   AGRIF_FixedGrids.in file.
+C
+CC    Method:
+CC    Recursive subroutine and creation of a first grid hierarchy from the
+CC    reading of the AGRIF_FixedGrids.in file.        
+C
+C     Declarations:
+C
+C     Pointer argument      
+      TYPE(AGRIF_rectangle), Pointer   :: coarsegrid ! Pointer on the first grid
+                                                     ! of the grid hierarchy
+C                                    
+C     Scalar arguments                                    
+      INTEGER                          :: j          ! Number of the new grid
+      INTEGER                          :: nunit      ! unit associated with file
+C      
+C     Local variables      
+      TYPE(AGRIF_rectangle)            :: newrect    ! Pointer on a new grid   
+      TYPE(AGRIF_lrectangle), Pointer  :: parcours   ! Pointer for the recursive
+                                                     !    procedure
+      TYPE(AGRIF_lrectangle), Pointer  :: newlrect
+      TYPE(AGRIF_lrectangle), Pointer  :: end_list       
+      INTEGER                          :: i          ! for each child grid
+      INTEGER                          :: nb_grids   ! Number of child grids
+      INTEGER                          :: iii
+C          
+C
+      Nullify(newrect%childgrids)
+C      
+C     Reading of the number of child grids        
+      read(nunit,*) nb_grids
+C      
+C     coarsegrid%nbgridchild = nb_grids
+C      
+      allocate(end_list)
+C
+      nullify(end_list % r)
+      nullify(end_list % next)
+C      
+      coarsegrid % childgrids => end_list
+C
+C     Reading of imin(1),imax(1),imin(2),imax(2),imin(3),imax(3), and space and
+C        time refinement factors for each child grid.
+C     Creation and addition of the new grid to the grid hierarchy. 
+C
+      do i = 1,nb_grids
+        allocate(newlrect)      
+        newrect % number = j   ! Number of the grid
+C
+        if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
+           if (Agrif_Probdim == 3) then  
+            read(nunit,*) newrect % imin(1), newrect % imax(1),
+     &                    newrect % imin(2), newrect % imax(2),
+     &                    newrect % imin(3), newrect % imax(3),
+     &                    newrect % spaceref(1),newrect % spaceref(2),
+     &                    newrect % spaceref(3),
+     &                    newrect % timeref(1),newrect % timeref(2),
+     &                    newrect % timeref(3)
+           elseif (Agrif_Probdim == 2) then            
+            read(nunit,*) newrect % imin(1),newrect % imax(1),
+     &                  newrect % imin(2),newrect % imax(2),
+     &                    newrect % spaceref(1),newrect % spaceref(2),
+     &                    newrect % timeref(1),newrect % timeref(2)
+           elseif (Agrif_Probdim == 1) then
+            read(nunit,*) newrect % imin(1), newrect % imax(1),
+     &                    newrect % spaceref(1),
+     &                    newrect % timeref(1)
+           endif
+        else
+           if (Agrif_Probdim == 3) then  
+            read(nunit,*) newrect % imin(1), newrect % imax(1),
+     &                    newrect % imin(2), newrect % imax(2),
+     &                    newrect % imin(3), newrect % imax(3),
+     &                    newrect % spaceref(1),newrect % spaceref(2),
+     &                    newrect % spaceref(3),
+     &                    newrect % timeref(1)
+           elseif (Agrif_Probdim == 2) then            
+            read(nunit,*) newrect % imin(1),newrect % imax(1),
+     &                  newrect % imin(2),newrect % imax(2),
+     &                    newrect % spaceref(1),newrect % spaceref(2),
+     &                    newrect % timeref(1)
+           elseif (Agrif_Probdim == 1) then
+            read(nunit,*) newrect % imin(1), newrect % imax(1),
+     &                    newrect % spaceref(1),
+     &                    newrect % timeref(1)
+           endif
+C
+           if ( Agrif_probdim .GE. 2 ) then
+              do iii = 2 , Agrif_probdim
+                 newrect % timeref(iii) = newrect % timeref(1) 
+              enddo
+           endif
+C
+        endif
+C
+C       Addition to the grid hierarchy
+C
+        nullify(newrect % childgrids)
+        j = j + 1
+        Allocate(newlrect%r)
+        newlrect % r = newrect 
+        nullify(newlrect % next)
+        end_list % next => newlrect
+        end_list => end_list % next
+      enddo
+C      
+      coarsegrid % childgrids => coarsegrid % childgrids % next
+      parcours => coarsegrid % childgrids
+C
+C     Recursive operation to create the grid hierarchy branch by branch
+C
+      do while (associated(parcours))
+        call Agrif_Read_Fix_Grd (parcours % r,j,nunit)
+        parcours => parcours % next
+      enddo
+C      
+C
+      End Subroutine Agrif_Read_Fix_Grd        
+C        
+C 
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Create_Grids  
+C     **************************************************************************
+C
+      Recursive Subroutine Agrif_Create_Grids(g,coarsegrid)
+C
+CCC   Description:
+CCC   Subroutine to create the grid hierarchy (g) from the one created with the
+CCC   Agrif_Read_Fix_Grd or Agrif_Cluster_All procedures (coarsegrid).
+C
+CC    Method:
+CC    Recursive subroutine.        
+C
+C     Declarations:
+C
+C     Pointer arguments        
+      TYPE(AGRIF_grid)     , Pointer  :: g          ! Pointer on the root coarse
+                                                    ! grid
+      TYPE(AGRIF_rectangle), Pointer  :: coarsegrid ! Pointer on the root coarse
+                                                    ! grid of the grid hierarchy
+                                                    ! created with the
+                                                    ! Agrif_Read_Fix_Grd
+                                                    ! subroutine
+C
+C     Local pointers
+      TYPE(Agrif_grid)      , Pointer :: newgrid    ! New grid
+      TYPE(Agrif_pgrid)     , Pointer :: newpgrid
+      TYPE(Agrif_pgrid)     , Pointer :: parcours2
+      TYPE(Agrif_lrectangle), Pointer :: parcours
+      TYPE(Agrif_pgrid)     , Pointer :: end_list
+      TYPE(Agrif_pgrid)     , Pointer :: parcours3
+C
+C     Local scalars      
+      LOGICAL                         :: nullliste
+      INTEGER                         :: iii
+      INTEGER                         :: moving_grid_id = 0      
+
+C
+      parcours3 => g % child_grids
+C     
+      if (associated(parcours3)) then
+          do While (associated(parcours3 % next))
+            parcours3 => parcours3 % next
+          enddo
+          end_list => parcours3
+          nullliste=.FALSE.
+        else
+          allocate(end_list)
+          nullify(end_list % gr)
+          nullify(end_list % next)      
+          g % child_grids => end_list 
+          parcours3 => end_list      
+          nullliste=.TRUE.
+      endif
+C      
+      parcours => coarsegrid % childgrids
+C      
+C     Creation of the grid hierarchy from the one created by using the 
+C     Agrif_Read_Fix_Grd subroutine 
+C
+      do while (associated(parcours))
+        allocate(newgrid)        
+        moving_grid_id=moving_grid_id+1
+        newgrid % grid_id = moving_grid_id
+        do iii = 1 , Agrif_Probdim
+           newgrid % spaceref(iii) = parcours % r % spaceref(iii)
+           newgrid % timeref(iii) = parcours % r % timeref(iii)
+        enddo
+C
+        do iii = 1 , Agrif_Probdim
+          newgrid % nb(iii) = (parcours % r % imax(iii) 
+     &                       - parcours % r % imin(iii)) 
+     &                       * parcours % r % spaceref(iii)
+C     
+          newgrid % ix(iii) =  parcours % r % imin(iii)
+C
+          newgrid % Agrif_d(iii) = g % Agrif_d(iii) 
+     &                  / REAL(newgrid % spaceref(iii))
+C
+          newgrid % Agrif_x(iii) = g % Agrif_x(iii) +
+     &      (parcours % r % imin(iii) - 1)* g % Agrif_d(iii)
+C      
+        enddo
+C
+C       Pointer on the parent grid                        
+C
+        newgrid % parent => g      
+
+C       Level of the current grid
+        newgrid % level = newgrid % parent % level + 1
+        if (newgrid % level > Agrif_MaxLevelLoc) then
+          Agrif_MaxLevelLoc = newgrid%level
+        endif
+
+C      
+C       Grid pointed by newgrid is a fixed grid      
+C
+        if (parcours % r % number .GT. 0) then      
+            newgrid % fixed = .true.  
+          else
+            newgrid % fixed = .false.
+        endif
+C
+C       Number of the grid pointed by newgrid
+        newgrid % fixedrank = parcours % r % number
+C           
+C       No time calculation on this grid         
+        newgrid % ngridstep = 0      
+C
+C       Test indicating if the current grid has a common border with the root 
+C       coarse grid in the x direction
+        do iii = 1 , Agrif_Probdim
+           newgrid % NearRootBorder(iii) = .FALSE.
+C        
+           if ((newgrid % parent % NearRootBorder(iii)) .AND. 
+     &         (newgrid % ix(iii) == 1)) then
+               newgrid % NearRootBorder(iii) = .TRUE.
+           endif
+C
+           newgrid % DistantRootBorder(iii) = .FALSE.
+C 
+           if ((newgrid % parent % DistantRootBorder(iii)) .AND. 
+     &         (newgrid % ix(iii) + 
+     &         (newgrid % nb(iii)/newgrid % spaceref(iii))  
+     &          - 1  == newgrid % parent % nb(iii))) then
+               newgrid % DistantRootBorder(iii) = .TRUE.
+           endif
+        enddo
+C
+C       Writing in output files
+C
+        newgrid % oldgrid = .FALSE.      
+C
+C     
+C       Definition of the CHARACTERistics of the variable of the grid pointed by
+C       newgrid 
+        Call Agrif_Create_Var (newgrid)
+C      
+C       Instanciation of the grid pointed by newgrid and its variables
+        Call Agrif_Instance (newgrid)
+C       
+C       Nullify the variable of the grid pointed by newgrid
+C
+C
+C       Addition of this grid to the grid hierarchy 
+C      
+        nullify(newgrid % child_grids)
+        allocate(newpgrid)  
+        newpgrid % gr => newgrid
+        nullify(newpgrid % next)
+        end_list % next => newpgrid
+        end_list => end_list % next               
+        parcours => parcours % next
+C
+C       Updating the total number of fixed grids
+        if (newgrid % fixed) then
+            AGRIF_nbfixedgrids = AGRIF_nbfixedgrids + 1
+        endif
+C                  
+      enddo
+C
+C
+      if (nullliste) then
+          g % child_grids => g % child_grids % next
+          parcours2 => g % child_grids
+          deallocate(parcours3)
+        else
+          parcours2 => parcours3 % next
+      endif
+C      
+      parcours => coarsegrid % childgrids
+C
+C     Recursive call to the subroutine Agrif_Create_Fixed_Grids to create the
+C     grid hierarchy
+C      
+      do while (associated(parcours))
+        Call Agrif_Create_Grids (parcours2 % gr,parcours % r)
+        parcours => parcours % next
+        parcours2 => parcours2 % next
+      enddo 
+C      
+      Return      
+C                  
+      End Subroutine Agrif_Create_Grids
+C
+C      
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Init_Hierarchy  
+C     **************************************************************************
+C
+      Recursive Subroutine Agrif_Init_Hierarchy(g) 
+C
+CCC   Description:
+CCC   Subroutine to initialize all the grids except the root coarse grid (this 
+CCC   one, pointed by AGRIF_mygrid, is initialized by the subroutine 
+CCC   Agrif_Init_Grids defi ned in the module Agrif_Util and called in the main 
+CCC   program ). 
+C
+CC    Method:
+CC    Recursive subroutine.        
+C
+C     Declarations:
+C
+C     Pointer argument      
+      TYPE(AGRIF_grid), Pointer  :: g         ! Pointer on the root coarse grid 
+C      
+C     Local variables      
+      TYPE(AGRIF_pgrid), Pointer :: parcours  ! Pointer for the recursive call
+      LOGICAL                    :: Init_Hierarchy
+C      
+C
+      parcours=>g%child_grids
+C      
+      do while (associated(parcours))
+        Init_Hierarchy = .false.
+        if ( AGRIF_USE_FIXED_GRIDS .EQ. 1 .OR. 
+     &       AGRIF_USE_ONLY_FIXED_GRIDS .EQ. 1 ) then
+           if ((parcours%gr%fixed) 
+     &         .AND. (Agrif_mygrid%ngridstep == 0)) then
+              Init_Hierarchy = .true.
+           endif      
+       endif
+C
+       if (.NOT. parcours%gr%fixed) Init_Hierarchy = .true.
+       if (parcours % gr % oldgrid) Init_Hierarchy = .false.
+C
+       if (Init_Hierarchy) then 
+C
+C           Instanciation of the grid pointed by parcours%gr and its variables 
+            Call Agrif_Instance (parcours % gr)
+C    
+C           Allocation of the arrays containing values of the variables of the
+C           grid pointed by parcours%gr      
+C      
+            Call Agrif_Allocation (parcours % gr)   
+C            
+            Call Agrif_initialisations(parcours % gr)              
+C       
+            Call Agrif_Instance(parcours % gr)
+C
+            if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
+              Call Agrif_Allocate_Restore (parcours % gr)
+            endif
+C
+            if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
+C              Initialization by copy of the grids created by clustering 
+               Call AGRIF_CopyFromold_All (parcours%gr,
+     &                                     Agrif_oldmygrid)
+            endif
+C
+C           Initialization by interpolation 
+C           (this routine is written by the user) 
+            Call Agrif_InitValues()
+C
+            if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
+               Call Agrif_Free_Restore (parcours % gr)
+            endif
+C
+       endif                                  
+       parcours => parcours % next 
+C         
+      enddo
+C
+      parcours => g % child_grids
+C      
+C     Recursive operation to initialize all the grids
+      do while (associated(parcours))
+        Call Agrif_Init_Hierarchy (parcours%gr)
+        parcours => parcours%next
+      enddo
+C      
+      End Subroutine Agrif_Init_Hierarchy 
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Allocate_Restore  
+C     **************************************************************************
+C
+      Subroutine Agrif_Allocate_Restore(Agrif_Gr)
+C      
+C      
+C     Modules used:
+C
+      TYPE(AGRIF_grid), Pointer  :: Agrif_Gr   ! Pointer on the root coarse grid
+C     
+      INTEGER                    :: i
+C
+        do i = 1 , Agrif_NbVariables
+            if ( Agrif_Mygrid%tabvars(i)%var % restaure ) then
+            if ( Agrif_Gr%tabvars(i)%var % nbdim .EQ. 1 ) then    
+            Allocate( Agrif_Gr%tabvars(i)%var%  
+     &    Restore1D(lbound(Agrif_Gr%tabvars(i)%var%array1,1) 
+     &    :ubound(Agrif_Gr%tabvars(i)%var%array1,1))) 
+            Agrif_Gr%tabvars(i)%var%Restore1D = 0
+C
+            endif
+            if ( Agrif_Gr%tabvars(i)%var % nbdim .EQ. 2 ) then
+            Allocate( Agrif_Gr%tabvars(i)%var%Restore2D(  
+     &      lbound(Agrif_Gr%tabvars(i)%var%array2,1):         
+     &      ubound(Agrif_Gr%tabvars(i)%var%array2,1),         
+     &      lbound(Agrif_Gr%tabvars(i)%var%array2,2)          
+     &      :ubound(Agrif_Gr%tabvars(i)%var%array2,2)))         
+            Agrif_Gr%tabvars(i)%var%Restore2D = 0
+C
+            endif
+            if ( Agrif_Mygrid%tabvars(i)%var % nbdim .EQ. 3 ) then
+C     
+            Allocate( Agrif_Gr%tabvars(i)%var%Restore3D( 
+     &      lbound(Agrif_Gr%tabvars(i)%var%array3,1):        
+     &      ubound(Agrif_Gr%tabvars(i)%var%array3,1),        
+     &      lbound(Agrif_Gr%tabvars(i)%var%array3,2):        
+     &      ubound(Agrif_Gr%tabvars(i)%var%array3,2),        
+     &      lbound(Agrif_Gr%tabvars(i)%var%array3,3):        
+     &      ubound(Agrif_Gr%tabvars(i)%var%array3,3)))  
+            Agrif_Gr%tabvars(i)%var%Restore3D = 0
+            endif
+C 
+            endif
+          enddo
+C
+      Return
+C
+C      
+      End Subroutine Agrif_Allocate_Restore      
+C
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Free_Restore  
+C     **************************************************************************
+C
+      Subroutine Agrif_Free_Restore(Agrif_Gr)
+C
+C      
+C     Pointer argument      
+      TYPE(AGRIF_grid), Pointer  :: Agrif_Gr   ! Pointer on the root coarse grid
+      INTEGER :: i     
+C
+      do i = 1 , Agrif_NbVariables
+         if ( Agrif_Mygrid % tabvars(i) % var % restaure) then
+C  
+            if (associated(Agrif_Gr%tabvars(i)%var%Restore1D)) then
+               Deallocate(Agrif_Gr%tabvars(i)%var%Restore1D)
+            endif
+            if (associated(Agrif_Gr%tabvars(i)%var%Restore2D)) then
+               Deallocate(Agrif_Gr%tabvars(i)%var%Restore2D)
+            endif
+            if (associated(Agrif_Gr%tabvars(i)%var%Restore3D)) then
+               Deallocate(Agrif_Gr%tabvars(i)%var%Restore3D)
+            endif
+            if (associated(Agrif_Gr%tabvars(i)%var%Restore4D)) then
+               Deallocate(Agrif_Gr%tabvars(i)%var%Restore4D)
+            endif
+            if (associated(Agrif_Gr%tabvars(i)%var%Restore5D)) then
+               Deallocate(Agrif_Gr%tabvars(i)%var%Restore5D)
+            endif
+            if (associated(Agrif_Gr%tabvars(i)%var%Restore6D)) then
+               Deallocate(Agrif_Gr%tabvars(i)%var%Restore6D)
+            endif
+C 
+        endif
+      enddo
+C 
+      Return
+C
+C      
+      End Subroutine Agrif_Free_Restore
+C
+C
+C
+      End Module Agrif_Clustering
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcurgridfunctions.F
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcurgridfunctions.F	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcurgridfunctions.F	(revision 8201)
@@ -0,0 +1,990 @@
+!
+! $Id: modcurgridfunctions.F 2715 2011-03-30 15:58:35Z rblod $
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place-  Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_CurgridFunctions      
+C      
+      Module Agrif_CurgridFunctions    
+C  
+CCC   Description:
+CCC   Module to define some procedures concerning the current grid
+C
+C     Modules used: 
+C
+      Use Agrif_Init
+C
+      IMPLICIT NONE
+C
+C
+      Contains
+C     Define procedures contained in this module
+C
+C     **************************************************************************
+CCC   Function Agrif_Rhot
+C     **************************************************************************
+C
+      Function Agrif_Rhot()
+C  
+CCC   Description:
+CCC   Function returning the time refinement factor of the current grid.
+C
+C     Declarations:
+C  
+      
+C
+      REAL :: Agrif_Rhot  ! Result
+C
+C     Local scalar      
+      INTEGER :: res         ! Intermediate result
+      INTEGER :: iii
+C
+C
+      res=1
+C
+      do iii = 1 , Agrif_Probdim
+         res = max(res, AGRIF_Curgrid % timeref(iii))
+      enddo
+C
+      Agrif_Rhot = float(res)
+C
+C
+      End function Agrif_rhot
+C
+C
+C
+C
+C     **************************************************************************
+CCC   Function Agrif_IRhot
+C     **************************************************************************
+C
+      Function Agrif_IRhot()
+C  
+CCC   Description:
+CCC   Function returning the time refinement factor of the current grid.
+C
+C     Declarations:
+C  
+      
+C
+      INTEGER :: Agrif_IRhot  ! Result
+C
+C     Local scalar      
+      INTEGER :: res         ! Intermediate result
+      INTEGER :: iii
+C
+C
+      res=1
+C
+      do iii = 1 , Agrif_Probdim
+         res = max(res, AGRIF_Curgrid % timeref(iii))
+      enddo
+C
+      Agrif_IRhot = res
+C
+C
+      End function Agrif_IRhot
+C
+C
+C
+C     **************************************************************************
+CCC   Function Agrif_Parent_Rhot
+C     **************************************************************************
+C
+      Function Agrif_Parent_Rhot()
+C  
+CCC   Description:
+CCC   Function returning the time refinement factor of the parent grid of the 
+CCC   current grid.
+C
+C     Declarations:
+C  
+      
+C
+      REAL :: Agrif_Parent_Rhot  ! Result
+C
+C     Local scalar      
+      INTEGER :: res         ! Intermediate result
+      INTEGER :: iii
+C
+C
+      res=1
+C
+      do iii = 1 , Agrif_Probdim
+         res = max(res, AGRIF_Curgrid % parent % timeref(iii))
+      enddo
+C
+      Agrif_Parent_Rhot = float(res)
+C
+C
+      End function Agrif_Parent_Rhot      
+C
+C
+C     **************************************************************************
+CCC   Function Agrif_Parent_IRhot
+C     **************************************************************************
+C
+      Function Agrif_Parent_IRhot()
+C  
+CCC   Description:
+CCC   Function returning the time refinement factor of the parent grid of the 
+CCC   current grid.
+C
+C     Declarations:
+C  
+      
+C
+      INTEGER :: Agrif_Parent_IRhot  ! Result
+C
+C     Local scalar      
+      INTEGER :: res         ! Intermediate result
+      INTEGER :: iii
+C
+C
+      res=1
+C
+      do iii = 1 , Agrif_Probdim
+         res = max(res, AGRIF_Curgrid % parent % timeref(iii))
+      enddo
+C
+      Agrif_Parent_IRhot = res
+C
+C
+      End function Agrif_Parent_IRhot      
+C
+C
+C     **************************************************************************
+CCC   Function Agrif_Nbstepint
+C     **************************************************************************
+C
+      Function Agrif_Nbstepint()
+C  
+CCC   Description:
+CCC   Function for the calculation of the coefficients used for the time 
+CCC   interpolation (module Agrif_Boundary).
+C
+C     Declarations:
+C  
+      
+C            
+      INTEGER :: Agrif_nbstepint  ! result
+C
+C
+      Agrif_nbstepint = mod(AGRIF_CURGRID % ngridstep,
+     &                      int(AGRIF_rhot()))
+C
+C
+      End function Agrif_Nbstepint
+C
+C
+C
+CC    **************************************************************************
+CCC   Function Agrif_Parent_Nbstepint
+C     **************************************************************************
+C
+      Function Agrif_Parent_Nbstepint()
+C  
+CCC   Description:
+CCC   Function for the calculation of the coefficients used for the time 
+CCC   interpolation (module Agrif_Boundary).
+C
+C     Declarations:
+C  
+      
+C            
+      INTEGER :: Agrif_Parent_Nbstepint  ! result
+C
+C
+      Agrif_Parent_Nbstepint = mod(AGRIF_CURGRID % parent % ngridstep, 
+     &                             int(AGRIF_Parent_Rhot()))
+C
+C
+      End function Agrif_Parent_Nbstepint
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_InterpNearBorderX
+C     **************************************************************************
+C
+      Subroutine Agrif_InterpNearBorderX()
+C  
+CCC   Description:
+CCC   Subroutine allowing to interpole (in the x direction) on a near border of 
+CCC   the current grid if this one has a common border with the root coarse 
+CCC   grid.   
+C
+C     Declarations:
+C  
+      
+C
+C
+      AGRIF_CURGRID % NearRootBorder(1) = .FALSE.             
+C
+C
+      End Subroutine Agrif_InterpNearBorderX 
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_InterpDistantBorderX
+C     **************************************************************************
+C
+      Subroutine Agrif_InterpDistantBorderX()
+C  
+CCC   Description:
+CCC   Subroutine allowing to interpole (in the x direction) on a distant border 
+CCC   of the current grid if this one has a common border with the root coarse  
+CCC   grid.
+C
+C     Declarations:
+C  
+
+C
+C
+      AGRIF_CURGRID % DistantRootBorder(1) = .FALSE.             
+C
+C
+      End Subroutine Agrif_InterpDistantBorderX                 
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_InterpNearBorderY
+C     **************************************************************************
+C
+      Subroutine Agrif_InterpNearBorderY()
+C  
+CCC   Description:
+CCC   Subroutine allowing to interpole (in the y direction) on a near border of 
+CCC   the current grid if this one has a common border with the root coarse 
+CCC   grid.
+C
+C     Declarations:
+C  
+      
+C
+C
+      AGRIF_CURGRID % NearRootBorder(2) = .FALSE.             
+C
+C
+      End Subroutine Agrif_InterpNearBorderY
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_InterpDistantBorderY
+C     **************************************************************************
+C
+      Subroutine Agrif_InterpDistantBorderY()
+C  
+CCC   Description:
+CCC   Subroutine allowing to interpole (in the y direction) on a distant border 
+CCC   of the current grid if this one has a common border with the root coarse  
+CCC   grid.
+C
+C     Declarations:
+C  
+      
+C
+C
+      AGRIF_CURGRID % DistantRootBorder(2) = .FALSE.             
+C
+C
+      End Subroutine Agrif_InterpDistantBorderY      
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_InterpNearBorderZ
+C     **************************************************************************
+C
+      Subroutine Agrif_InterpNearBorderZ()
+C  
+CCC   Description:
+CCC   Subroutine allowing to interpole (in the z direction) on a near border of 
+CCC   the current grid if this one has a common border with the root coarse 
+CCC   grid.
+C
+C     Declarations:
+C  
+      
+C
+C
+      AGRIF_CURGRID % NearRootBorder(3) = .FALSE.             
+C
+C
+      End Subroutine Agrif_InterpNearBorderZ
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_InterpDistantBorderZ
+C     **************************************************************************
+C
+      Subroutine Agrif_InterpDistantBorderZ()
+C  
+CCC   Description:
+CCC   Subroutine allowing to interpole (in the z direction) on a distant border 
+CCC   of the current grid if this one has a common border with the root coarse  
+CCC   grid.
+C
+C     Declarations:
+C  
+      
+C
+C
+      AGRIF_CURGRID % DistantRootBorder(3) = .FALSE.             
+C
+C
+      End Subroutine Agrif_InterpDistantBorderZ
+C 
+C     **************************************************************************
+CCC   Function Agrif_Parent_Nb_Step
+C     ************************************************************************** 
+C 
+      Function AGRIF_Parent_Nb_Step() 
+C  
+CCC   Description:
+CCC   Function returning the number of time steps of the parent grid of the
+CCC   current grid.
+C
+C     Declarations:
+C    
+      
+C
+      INTEGER :: AGRIF_Parent_Nb_Step ! Result 
+C
+C
+      if (Agrif_Root()) then  
+C     
+          Agrif_Parent_Nb_Step = -1 
+C       
+        else
+C       
+          Agrif_Parent_Nb_Step = Agrif_Curgrid % parent % ngridstep
+C     
+      endif
+C
+C     
+      End function Agrif_Parent_Nb_Step    
+C 
+C
+C 
+C     **************************************************************************
+CCC   Function Agrif_Root
+C     **************************************************************************
+C
+      Function Agrif_Root()
+C     
+CCC   Description:
+CCC   Function indicating if the current grid is or not the root grid.
+C
+C     Declarations:
+C
+      
+C
+      LOGICAL :: Agrif_Root   ! Result
+C    
+C
+      if (AGRIF_CURGRID % fixedrank .EQ. 0) then
+C          
+          Agrif_Root = .TRUE.
+C    
+        else
+C    
+          Agrif_Root = .FALSE.
+C     
+      endif
+C
+C    
+      End function Agrif_Root
+C
+C
+C
+C     **************************************************************************
+CCC   Function Agrif_Parent_Root
+C     **************************************************************************
+C
+      Function Agrif_Parent_Root()
+C     
+CCC   Description:
+CCC   Function indicating if the parent grid of the current grid is or not the 
+CCC   root grid.
+C
+C     Declarations:
+C
+      
+C
+      LOGICAL :: Agrif_Parent_Root   ! Result
+C    
+C
+      if (AGRIF_CURGRID % parent % fixedrank .EQ. 0) then
+C          
+          Agrif_Parent_Root = .TRUE.
+C    
+        else
+C    
+          Agrif_Parent_Root = .FALSE.
+C     
+      endif
+C
+C    
+      End function Agrif_Parent_Root     
+C 
+C
+C 
+C     **************************************************************************
+CCC   Function Agrif_Fixed
+C     **************************************************************************
+C 
+      Function Agrif_Fixed()
+C  
+CCC   Description:
+CCC   Function returning the number of the current grid.
+C
+C     Declarations:
+C   
+      
+C
+      INTEGER Agrif_Fixed   ! Result 
+C 
+C
+      if (Agrif_Curgrid % fixed) then
+C     
+          Agrif_Fixed = Agrif_Curgrid % fixedrank 
+C
+        else
+C     
+         Agrif_Fixed = -1
+C        
+      endif
+C
+C     
+      End function Agrif_Fixed 
+C
+C
+C
+C     **************************************************************************
+CCC   Function Agrif_Parent_Fixed
+C     **************************************************************************
+ 
+      Function Agrif_Parent_Fixed()
+C  
+CCC   Description:
+CCC   Function returning the number of the parent grid of the current grid.
+C
+C     Declarations:
+C   
+      
+C
+      INTEGER Agrif_Parent_Fixed   ! Result 
+C 
+C
+      if (Agrif_Curgrid % parent % fixed) then
+C     
+          Agrif_Parent_Fixed = AGRIF_CURGRID % parent % fixedrank 
+C
+        else
+C     
+         Agrif_Parent_Fixed = 0
+C        
+      endif
+C
+C     
+      End function Agrif_Parent_Fixed
+C
+C
+C
+C     **************************************************************************
+CCC   Function Agrif_Is_Fixed
+C     **************************************************************************
+ 
+      Function Agrif_Is_Fixed()
+C  
+CCC   Description:
+CCC   Function returning true if the current grid is fixed.
+C
+C     Declarations:
+C   
+      
+C
+      LOGICAL Agrif_Is_Fixed   ! Result 
+C 
+C
+      if (Agrif_Curgrid % fixed) then
+C     
+          Agrif_Is_Fixed = .true.
+C
+        else
+C     
+          Agrif_Is_Fixed = .false.
+C        
+      endif
+C
+C     
+      End function Agrif_Is_Fixed
+C
+C
+C
+C     **************************************************************************
+CCC   Function Agrif_Parent_Is_Fixed
+C     **************************************************************************
+ 
+      Function Agrif_Parent_Is_Fixed()
+C  
+CCC   Description:
+CCC   Function returning true if the parent grid of the current grid is fixed.
+C
+C     Declarations:
+C   
+      
+C
+      LOGICAL Agrif_Parent_Is_Fixed   ! Result 
+C 
+C
+      if (Agrif_Curgrid % parent % fixed) then
+C     
+          Agrif_Parent_Is_Fixed = .true.
+C
+        else
+C     
+          Agrif_Parent_Is_Fixed = .false.
+C        
+      endif
+C
+C     
+      End function Agrif_Parent_Is_Fixed            
+C
+C 
+C
+C     **************************************************************************
+CCC   Function AGRIF_CFixed
+C     **************************************************************************
+ 
+            Function AGRIF_CFixed()
+C  
+CCC   Description:
+CCC   Function returning the number of the current grid.
+C
+C     Declarations:
+C   
+      
+C
+      CHARACTER(3) AGRIF_CFixed   ! Result 
+C
+C     Local variables      
+      CHARACTER(3) cfixed
+      INTEGER fixed
+C 
+C
+      fixed = Agrif_Fixed()
+C      
+      if(fixed.NE.-1) then
+C
+           if (fixed .LE. 9) then
+C
+               write(cfixed,'(i1)')fixed
+C 
+           else
+C   
+               write(cfixed,'(i2)')fixed
+C      
+           endif
+C
+           AGrif_Cfixed=cfixed
+C      
+      else
+C
+      print*,'Call to AGRIF_CFixed() on a moving grid'
+      stop
+C
+      endif     
+
+      End function AGRIF_CFixed
+C
+C
+C
+C     **************************************************************************
+CCC   Function AGRIF_Parent_CFixed
+C     **************************************************************************
+ 
+      Function AGRIF_Parent_CFixed()
+C  
+CCC   Description:
+CCC   Function returning the number of the parent grid of the current grid.
+C
+C     Declarations:
+C   
+      
+C
+      CHARACTER(3) AGRIF_Parent_CFixed   ! Result 
+C
+C     Local variables      
+      CHARACTER(3) cfixed
+      INTEGER fixed
+C 
+C
+      fixed = Agrif_Parent_Fixed()
+C      
+      if(fixed.NE.-1) then
+C
+          if (fixed .LE. 9) then
+C
+              write(cfixed,'(i1)')fixed
+C      
+          else
+C        
+              write(cfixed,'(i2)')fixed
+C      
+          endif
+C
+          AGrif_Parent_Cfixed=cfixed
+C
+      else
+C
+      print*,'Illegal call to AGRIF_Parent_CFixed()'
+      stop     
+C
+      endif
+
+      End function AGRIF_Parent_CFixed      
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_ChildGrid_to_ParentGrid
+C     **************************************************************************
+C
+      Subroutine Agrif_ChildGrid_to_ParentGrid()
+C  
+CCC   Description:
+CCC   Subroutine allowing to make the pointer AGRIF_CURGRID point on the parent
+CCC   grid of the current grid.
+C
+C     Declarations:
+C  
+      
+C
+      
+      Agrif_Curgrid%Parent%save_grid => Agrif_Curgrid
+C
+      Call Agrif_Instance(Agrif_Curgrid%parent)            
+C
+C
+      End Subroutine Agrif_ChildGrid_to_ParentGrid
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_ParentGrid_to_ChildGrid
+C     **************************************************************************
+C
+      Subroutine Agrif_ParentGrid_to_ChildGrid()
+C  
+CCC   Description:
+CCC   Subroutine allowing to make the pointer AGRIF_CURGRID point on the child 
+CCC   grid after having called the Agrif_ChildGrid_to_ParentGrid subroutine.
+C
+C     Declarations:
+C  
+      
+C
+C
+      Call Agrif_Instance(Agrif_Curgrid%save_grid)
+C
+C
+      End Subroutine Agrif_ParentGrid_to_ChildGrid
+C
+C
+C
+C     **************************************************************************
+CCC   Function Agrif_Get_Unit
+C     **************************************************************************
+C
+      Function Agrif_Get_Unit()
+
+CCC   Description : return a unit not connected to any file
+C
+C     Declarations
+C
+      
+C
+      INTEGER Agrif_Get_Unit
+C
+C     Local scalars
+      INTEGER n
+      LOGICAL op
+C
+      INTEGER :: nunit
+      INTEGER :: iii,out,iiimax
+      Logical :: BEXIST
+      INTEGER,DIMENSION(1:1000) :: ForbiddenUnit
+C
+C
+C     Load forbidden Unit if the file Agrif_forbidenUnit exist
+C      
+
+      INQUIRE(FILE='Agrif_forbiddenUnit.txt',EXIST=BEXIST)
+      If (.not. BEXIST) Then
+c          File Agrif_forbiddenUnit.txt not found
+      Else
+           nunit = 777
+           open(nunit,file='Agrif_forbiddenUnit.txt',form='formatted',
+     &          status="old")
+              iii = 1
+              do while ( .TRUE. )
+                 read(nunit,*,END = 99) ForbiddenUnit(iii)
+                 iii = iii + 1
+              enddo
+   99         CONTINUE
+              iiimax = iii
+           close(nunit)
+      endif     
+C 
+      do n = 7,1000
+C 
+        Inquire(Unit=n,Opened=op)
+C
+        out = 0
+        if ( BEXIST .AND. .NOT.op) then
+           do iii = 1 , iiimax
+              if ( n .EQ. ForbiddenUnit(iii) ) out = 1
+           enddo
+        endif
+C
+        if (.NOT.op .AND. out .EQ. 0) exit
+C      
+      enddo
+C
+      Agrif_Get_Unit=n
+C
+C
+      End Function Agrif_Get_Unit
+      
+      Subroutine Agrif_Set_Efficiency(eff)
+      REAL :: eff
+      
+      IF ((eff.LT.0.).OR.(eff.GT.1)) THEN
+      write(*,*)'Error Efficiency should be between 0 and 1'
+      stop
+      ELSE
+      Agrif_efficiency = eff
+      ENDIF
+      End Subroutine Agrif_Set_Efficiency
+      
+      Subroutine Agrif_Set_Regridding(regfreq)
+      INTEGER :: regfreq
+      
+      IF (regfreq.LT.0) THEN
+      write(*,*)'Regridding frequency should be positive'
+      stop
+      ELSE
+      Agrif_regridding = regfreq
+      ENDIF
+      End Subroutine Agrif_Set_Regridding
+C
+C
+C     **************************************************************************
+CCC   subroutine Agrif_Set_coeffref_x
+C     **************************************************************************
+      subroutine Agrif_Set_coeffref_x(coefref)
+
+      integer :: coefref
+
+      if (coefref.LT.0) then
+         write(*,*)'Coefficient of raffinement should be positive'
+         stop
+      else
+         AGRIF_coeffref(1) = coefref
+      endif
+      end subroutine Agrif_Set_coeffref_x
+C
+C     **************************************************************************
+CCC   subroutine Agrif_Set_coeffref_y
+C     **************************************************************************
+      subroutine Agrif_Set_coeffref_y(coefref)
+
+      integer :: coefref
+
+      if (coefref.LT.0) then
+         write(*,*)'Coefficient of raffinement should be positive'
+         stop
+      else
+         AGRIF_coeffref(2) = coefref
+      endif
+      end subroutine Agrif_Set_coeffref_y
+C
+C     **************************************************************************
+CCC   subroutine Agrif_Set_coeffref_z
+C     **************************************************************************
+      subroutine Agrif_Set_coeffref_z(coefref)
+
+      integer :: coefref
+
+      if (coefref.LT.0) then
+         write(*,*)'Coefficient of raffinement should be positive'
+         stop
+      else
+         AGRIF_coeffref(3) = coefref
+      endif
+      end subroutine Agrif_Set_coeffref_z
+C
+C     **************************************************************************
+CCC   subroutine Agrif_Set_coeffreft_x
+C     **************************************************************************
+      subroutine Agrif_Set_coeffreft_x(coefref)
+
+      integer :: coefref
+
+      if (coefref.LT.0) then
+         write(*,*)'Coefficient of time raffinement should be positive'
+         stop
+      else
+         AGRIF_coeffreft(1) = coefref
+      endif
+      end subroutine Agrif_Set_coeffreft_x
+C
+C     **************************************************************************
+CCC   subroutine Agrif_Set_coeffreft_y
+C     **************************************************************************
+      subroutine Agrif_Set_coeffreft_y(coefref)
+
+      integer :: coefref
+
+      if (coefref.LT.0) then
+         write(*,*)'Coefficient of time raffinement should be positive'
+         stop
+      else
+         AGRIF_coeffreft(2) = coefref
+      endif
+      end subroutine Agrif_Set_coeffreft_y
+C
+C     **************************************************************************
+CCC   subroutine Agrif_Set_coeffreft_z
+C     **************************************************************************
+      subroutine Agrif_Set_coeffreft_z(coefref)
+
+      integer :: coefref
+
+      if (coefref.LT.0) then
+         write(*,*)'Coefficient of time raffinement should be positive'
+         stop
+      else
+         AGRIF_coeffreft(3) = coefref
+      endif
+      end subroutine Agrif_Set_coeffreft_z
+C
+C     **************************************************************************
+CCC   subroutine Agrif_Set_Minwidth
+C     **************************************************************************
+      subroutine Agrif_Set_Minwidth(coefminwidth)
+
+      integer :: coefminwidth
+
+      if (coefminwidth.LT.0) then
+         write(*,*)'Coefficient of Minwidth should be positive'
+         stop
+      else
+         Agrif_Minwidth = coefminwidth
+      endif
+      end subroutine Agrif_Set_Minwidth
+C
+C     **************************************************************************
+CCC   subroutine Agrif_Set_Rafmax
+C     **************************************************************************
+      subroutine Agrif_Set_Rafmax(coefrafmax)
+
+      integer :: coefrafmax
+      integer :: i
+      real :: res
+
+      if (coefrafmax.LT.0) then
+         write(*,*)'Coefficient of  should be positive'
+         stop
+      else
+         res = 1.
+         do i = 1 , coefrafmax - 1
+            res = res * FLOAT(AGRIF_coeffref(1))
+         enddo
+         if ( res .EQ. 0 ) res = 1
+         Agrif_Mind(1) = 1. / res
+C
+         res = 1.
+         do i = 1 , coefrafmax - 1
+            res = res * FLOAT(AGRIF_coeffref(2))
+         enddo
+         if ( res .EQ. 0 ) res = 1
+         Agrif_Mind(2) = 1. / res
+C
+         res = 1.
+         do i = 1 , coefrafmax - 1
+            res = res * FLOAT(AGRIF_coeffref(3))
+         enddo
+         if ( res .EQ. 0 ) res = 1
+         Agrif_Mind(3) = 1. / res
+C
+      endif
+      end subroutine Agrif_Set_Rafmax
+C
+C     **************************************************************************
+CCC   subroutine Agrif_Open_File
+C     **************************************************************************
+      subroutine Agrif_Open_File(num_id,name_file)
+
+      integer :: num_id
+      character(*) :: name_file
+
+      num_id = Agrif_Get_Unit()
+      if ( .NOT. Agrif_Root() ) then
+         name_file = TRIM(Agrif_CFixed())//'_'//TRIM(name_file)
+      endif
+
+      end subroutine Agrif_Open_File
+
+C     **************************************************************************
+CCC    subroutine Agrif_Set_MaskMaxSearch
+C     **************************************************************************
+      subroutine Agrif_Set_MaskMaxSearch(mymaxsearch)
+      integer mymaxsearch
+      MaxSearch = mymaxsearch
+      end subroutine Agrif_Set_MaskMaxSearch
+      
+C *****************************************************************
+CCC  subroutine Agrif_Level
+C *****************************************************************
+      Function Agrif_Level()
+      Integer :: Agrif_Level
+     
+      Agrif_Level = Agrif_Curgrid % level
+     
+      End Function Agrif_Level
+      
+C *****************************************************************
+CCC  subroutine Agrif_MaxLevel
+C *****************************************************************
+      Function Agrif_MaxLevel()
+      Integer :: Agrif_MaxLevel
+     
+      Agrif_MaxLevel = Agrif_MaxLevelLoc
+     
+      End Function Agrif_MaxLevel      
+
+      End Module Agrif_CurgridFunctions 
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modflux.F
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modflux.F	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modflux.F	(revision 8201)
@@ -0,0 +1,339 @@
+C     Agrif (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place-Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_fluxmod
+C
+      Module Agrif_fluxmod
+      Use Agrif_types
+      Use Agrif_Arrays
+      Use Agrif_Curgridfunctions
+      
+      CONTAINS  
+      
+      
+      Subroutine Agrif_AllocateFlux(Flux,fluxtab)
+      Type(Agrif_Flux), Pointer :: Flux
+      Real, Dimension(:,:) :: fluxtab
+      Type(Agrif_Profile), Pointer :: Profile
+      Integer :: dimensio,n,n2
+      INTEGER, DIMENSION(:,:), Pointer :: normalsizes
+      INTEGER, DIMENSION(6) :: unitarray
+      Type(Agrif_Variable), Pointer :: fluxtabvar
+      Integer :: nbout
+      
+      Profile => Flux%profile
+      dimensio = Profile%nbdim
+      
+      unitarray = 1
+      
+      do n=1,dimensio
+        IF (Profile%posvar(n) == 1) THEN
+          IF (Profile%interptab(n) == 'x') THEN
+            Allocate(Flux%fluxtabx)
+            fluxtabvar => Flux%fluxtabx
+          ELSE IF (Profile%interptab(n) == 'y') THEN
+            Allocate(Flux%fluxtaby)
+            fluxtabvar => Flux%fluxtaby
+          ELSE IF (Profile%interptab(n) == 'z') THEN
+            Allocate(Flux%fluxtabz)
+            fluxtabvar => Flux%fluxtabz
+          ENDIF
+          ALLOCATE(fluxtabvar%iarray2(2,6))
+          normalsizes=>fluxtabvar%iarray2
+          normalsizes(1,1) = 2
+          nbout = 1
+          DO n2 = 1,dimensio
+            IF (n2 .NE. n) THEN
+              nbout = nbout + 1
+              If ((Profile%posvar(n2) == 1)
+     &            .OR.(Profile%posvar(n2) == 2)) THEN
+                IF (Profile%interptab(n2) == 'x') THEN
+                  normalsizes(2,n2) = 
+     &                Agrif_Curgrid%nb(1)/agrif_Curgrid%spaceref(1)
+                  normalsizes(1,nbout) = 
+     &                Agrif_Curgrid%nb(1)/agrif_Curgrid%spaceref(1)
+                ELSE IF (Profile%interptab(n2) == 'y') THEN
+                  normalsizes(2,n2) = 
+     &                Agrif_Curgrid%nb(2)/agrif_Curgrid%spaceref(2)
+                  normalsizes(1,nbout) = 
+     &                Agrif_Curgrid%nb(2)/agrif_Curgrid%spaceref(2)
+                ELSE IF (Profile%interptab(n2) == 'z') THEN
+                  normalsizes(2,n2) = 
+     &                Agrif_Curgrid%nb(3)/agrif_Curgrid%spaceref(3)
+                  normalsizes(1,nbout) = 
+     &                Agrif_Curgrid%nb(3)/agrif_Curgrid%spaceref(3)
+                ENDIF
+              ELSE
+                normalsizes(2,n2) = SIZE(fluxtab,n2)
+                normalsizes(1,nbout) = SIZE(fluxtab,n2)
+              ENDIF
+            ENDIF
+          ENDDO          
+        ENDIF
+      enddo
+      
+      
+      do n=1,dimensio
+        IF (Profile%posvar(n) == 1) THEN
+          IF (Profile%interptab(n) == 'x') THEN
+            fluxtabvar => Flux%fluxtabx
+          ELSE IF (Profile%interptab(n) == 'y') THEN
+            fluxtabvar => Flux%fluxtaby
+          ELSE IF (Profile%interptab(n) == 'z') THEN
+            fluxtabvar => Flux%fluxtabz
+          ENDIF
+          Call Agrif_nbdim_allocation(fluxtabvar,unitarray(1:dimensio),
+     &          fluxtabvar%iarray2(1,1:dimensio),dimensio)
+        ENDIF
+      enddo
+      
+      Flux%fluxallocated = .TRUE.
+      
+      End Subroutine Agrif_AllocateFlux
+      
+      FUNCTION Agrif_Search_Flux(fluxname)
+      character*(*) fluxname
+      Type(Agrif_Flux), Pointer :: Agrif_Search_Flux
+      
+      Type(Agrif_Flux), pointer :: parcours
+      Logical :: foundflux
+      
+      foundflux = .FALSE.
+      parcours => Agrif_Curgrid%fluxes
+      
+      Do While (Associated(parcours))
+         IF (parcours % fluxname == fluxname) THEN
+           foundflux = .TRUE.
+           EXIT
+         ENDIF
+         parcours => parcours%nextflux
+      End Do
+      
+      IF (.NOT.foundflux) THEN
+      write(*,*) 'The array flux '''
+     &           //TRIM(fluxname)//''' has not been declared'
+      stop
+      ENDIF      
+      
+      Agrif_Search_Flux => parcours
+      
+      End Function Agrif_Search_Flux
+      
+      Subroutine Agrif_Save_Fluxtab(Flux,Fluxtab)
+      Type(Agrif_Flux), Pointer :: Flux
+      Real, Dimension(:,:) :: Fluxtab
+      INTEGER, DIMENSION(:,:), Pointer :: normalsizes
+      INTEGER, DIMENSION(6) :: normalsizes2, normalsizes3
+      INTEGER, DIMENSION(6) :: unitarray2, unitarray3
+      Type(Agrif_Variable), Pointer :: fluxtabvar
+      Type(Agrif_Profile), Pointer :: Profile
+      Integer :: dimensio,n,n2,j,j1,j2
+      
+      Profile => Flux%profile
+      dimensio = Profile%nbdim
+            
+      do n=1,dimensio
+        IF (Profile%posvar(n) == 1) THEN
+          IF (Profile%interptab(n) == 'x') THEN
+            fluxtabvar => Flux%fluxtabx
+          ELSE IF (Profile%interptab(n) == 'y') THEN
+            fluxtabvar => Flux%fluxtaby
+          ELSE IF (Profile%interptab(n) == 'z') THEN
+            fluxtabvar => Flux%fluxtabz
+          ENDIF 
+          normalsizes => fluxtabvar%iarray2
+          unitarray2 = 1
+          unitarray3 = 1
+          normalsizes2 = normalsizes(1,:)
+          normalsizes3 = normalsizes(2,:)
+          
+          unitarray3(n) = Profile%point(n)
+          normalsizes3(n) = Profile%point(n) 
+                              
+          SELECT CASE(dimensio)
+          CASE(1)
+          CASE(2)
+            j1 = unitarray3(2)
+            Do j=unitarray3(2),normalsizes3(2)
+            do j2 = j1,j1+Agrif_curgrid%spaceref(2)
+!            print *,'flux stocke fiun = ',j2,fluxtab(unitarray3(1),j2)
+            enddo
+            fluxtabvar%array2(1:1,j) = 
+     &      fluxtabvar%array2(1:1,j) +
+     &             SUM(fluxtab(unitarray3(1):normalsizes3(1),
+     &                        j1:j1+Agrif_Curgrid%spaceref(2)))
+             j1 = j1+Agrif_Curgrid%spaceref(2)
+            EndDo
+          END SELECT
+          
+          unitarray3(n) = Profile%point(n)+Agrif_Curgrid%nb(n)
+          normalsizes3(n) = Profile%point(n)+Agrif_Curgrid%nb(n) 
+          SELECT CASE(dimensio)
+          CASE(1)
+          CASE(2)
+            j1 = unitarray3(2)
+            Do j=unitarray3(2),normalsizes3(2)
+            fluxtabvar%array2(2:2,j) = 
+     &      fluxtabvar%array2(2:2,j) +
+     &             SUM(fluxtab(unitarray3(1):normalsizes3(1),
+     &                        j1:j1+Agrif_Curgrid%spaceref(2)))
+             j1 = j1+Agrif_Curgrid%spaceref(2)
+            EndDo
+         END SELECT
+        ENDIF
+      enddo
+                  
+      End Subroutine Agrif_Save_Fluxtab
+
+      Subroutine Agrif_Save_Fluxtab_child(Flux,Fluxtab)
+      Type(Agrif_Flux), Pointer :: Flux
+      Real, Dimension(:,:) :: Fluxtab
+      INTEGER, DIMENSION(:,:), Pointer :: normalsizes
+      INTEGER, DIMENSION(6) :: normalsizes2, normalsizes3
+      INTEGER, DIMENSION(6) :: unitarray2, unitarray3
+      Type(Agrif_Variable), Pointer :: fluxtabvar
+      Type(Agrif_Profile), Pointer :: Profile
+      Integer :: dimensio,n,n2
+      
+      Profile => Flux%profile
+      dimensio = Profile%nbdim
+            
+      do n=1,dimensio
+        IF (Profile%posvar(n) == 1) THEN
+          IF (Profile%interptab(n) == 'x') THEN
+            fluxtabvar => Flux%fluxtabx
+          ELSE IF (Profile%interptab(n) == 'y') THEN
+            fluxtabvar => Flux%fluxtaby
+          ELSE IF (Profile%interptab(n) == 'z') THEN
+            fluxtabvar => Flux%fluxtabz
+          ENDIF 
+          normalsizes => fluxtabvar%iarray2
+          unitarray2 = 1
+          unitarray3 = 1
+          normalsizes2 = normalsizes(1,:)
+          normalsizes3 = normalsizes(2,:)
+          
+          unitarray3(n) = Profile%point(n)+Agrif_Curgrid%ix(n)
+          normalsizes3(n) = unitarray3(n)
+                              
+          SELECT CASE(dimensio)
+          CASE(1)
+          CASE(2)
+            fluxtabvar%array2(1:1,
+     &                        unitarray2(2):normalsizes2(2)) = 
+     &      - fluxtab(unitarray3(1):normalsizes3(1),
+     &                        unitarray3(2):normalsizes3(2))
+!        print *,'flux stocke = ',fluxtab(unitarray3(1):normalsizes3(1),
+!     &                        unitarray3(2):normalsizes3(2))
+          END SELECT
+          
+          unitarray3(n) = unitarray3(n)+
+     &         Agrif_Curgrid%nb(n)/Agrif_Curgrid%spaceref(n)
+          normalsizes3(n) = unitarray3(n)
+          SELECT CASE(dimensio)
+          CASE(1)
+          CASE(2)
+            fluxtabvar%array2(2:2,
+     &                        unitarray2(2):normalsizes2(2)) = 
+     &      - fluxtab(unitarray3(1):normalsizes3(1),
+     &                        unitarray3(2):normalsizes3(2))    
+         END SELECT
+        ENDIF
+      enddo
+                  
+      End Subroutine Agrif_Save_Fluxtab_child
+      
+      Subroutine Agrif_Cancel_Fluxarray(Flux)
+      Type(Agrif_Flux), Pointer :: Flux
+      Type(Agrif_Variable), Pointer :: fluxtabvar
+      Type(Agrif_Profile), Pointer :: Profile
+      Integer :: dimensio,n,n2
+      
+      Profile => Flux%profile
+      dimensio = Profile%nbdim
+            
+      do n=1,dimensio
+        IF (Profile%posvar(n) == 1) THEN
+          IF (Profile%interptab(n) == 'x') THEN
+            fluxtabvar => Flux%fluxtabx
+          ELSE IF (Profile%interptab(n) == 'y') THEN
+            fluxtabvar => Flux%fluxtaby
+          ELSE IF (Profile%interptab(n) == 'z') THEN
+            fluxtabvar => Flux%fluxtabz
+          ENDIF 
+                              
+          SELECT CASE(dimensio)
+          CASE(1)
+          CASE(2)
+            fluxtabvar%array2 = 0.
+          END SELECT
+        ENDIF
+      enddo
+                  
+      End Subroutine Agrif_Cancel_Fluxarray  
+      
+      Subroutine Agrif_FluxCorrect(Flux, procname)
+      Type(Agrif_Flux), Pointer :: Flux
+      External :: procname
+      Type(Agrif_Variable), Pointer :: fluxtabvar
+      Type(Agrif_Profile), Pointer :: Profile
+      Integer :: dimensio,n,n2,j1,j2
+      Integer, Dimension(:), Allocatable :: Loctab
+      Integer :: locind
+      
+      Profile => Flux%profile
+      dimensio = Profile%nbdim
+
+      do n=1,dimensio
+        IF (Profile%posvar(n) == 1) THEN
+          IF (Profile%interptab(n) == 'x') THEN
+            fluxtabvar => Flux%fluxtabx
+            locind = 1
+          ELSE IF (Profile%interptab(n) == 'y') THEN
+            fluxtabvar => Flux%fluxtaby
+            locind = 2
+          ELSE IF (Profile%interptab(n) == 'z') THEN
+            fluxtabvar => Flux%fluxtabz
+            locind = 3
+          ENDIF 
+                              
+          SELECT CASE(dimensio)
+          CASE(1)
+          CASE(2)
+           Allocate(Loctab(2))
+           Loctab(1) = Agrif_Curgrid%ix(locind)
+           Loctab(2) = Agrif_Curgrid%ix(locind)+
+     &         Agrif_Curgrid%nb(locind)/Agrif_Curgrid%spaceref(locind)
+           j1 = agrif_curgrid%ix(2)
+           j2 = agrif_curgrid%ix(2)+
+     &        agrif_curgrid%nb(2)/Agrif_curgrid%spaceref(2)
+           Call Agrif_ChildGrid_to_ParentGrid()
+            Call procname(fluxtabvar%array2,Loctab(1),Loctab(2),j1,j2)
+           Call Agrif_ParentGrid_to_ChildGrid()
+          END SELECT
+        ENDIF
+      enddo
+      
+      If (Allocated(Loctab)) Deallocate(Loctab)
+                  
+      End Subroutine Agrif_FluxCorrect 
+          
+      End Module Agrif_fluxmod
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinit.F
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinit.F	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinit.F	(revision 8201)
@@ -0,0 +1,252 @@
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place-  Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_Init
+C
+      Module Agrif_Init 
+C
+CCC   Description:
+CCC   Several operations on the variables of the current grid (creation,
+CCC   instanciation, ...) used during the creation of the grid hierarchy and
+CCC   during the time integration.
+C
+C     Modules used: 
+C
+      Use Agrif_Types 
+      Use Agrif_link
+C   
+      IMPLICIT NONE
+C
+      Contains
+C     Defininition of the procedures contained in this module
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Allocation  
+C     **************************************************************************
+C  
+      Subroutine Agrif_Allocation(Agrif_Gr)
+C
+CCC   Description:
+CCC   Subroutine to allocate the arrays containing the values of the variables 
+CCC   of the current grd.
+C
+CC    Method:
+CC    Use of the allocate function.  
+C
+C     Declarations:
+C      
+C     Pointer argument:
+      TYPE(AGRIF_grid), Pointer :: Agrif_Gr  ! Pointer on the current grid
+C 
+C     Allocation of the arrays of the variables  
+C     We cut this in several files to avoid long compilation timings
+C
+      Call Agrif_Allocationcalls(Agrif_Gr)
+C
+      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
+C
+         if ( Agrif_Probdim .EQ. 1 ) 
+     &      Allocate(Agrif_Gr%tabpoint1D(Agrif_Gr%nb(1)+1))
+         if ( Agrif_Probdim .EQ. 2 ) 
+     &      Allocate(Agrif_Gr%tabpoint2D(Agrif_Gr%nb(1)+1,
+     &       Agrif_Gr%nb(2)+1))      
+         if ( Agrif_Probdim .EQ. 3 ) 
+     &      Allocate(Agrif_Gr%tabpoint3D(Agrif_Gr%nb(1)+1,
+     &       Agrif_Gr%nb(2)+1,Agrif_Gr%nb(3)+1))      
+C
+      endif
+C 
+      End Subroutine Agrif_Allocation
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Instance 
+C     **************************************************************************
+C 
+      Subroutine Agrif_Instance(Agrif_Gr)
+C
+CCC   Description:
+CCC   Subroutine to do an instance of the common variables to the variables of  
+CCC   the current grid.
+C
+CC    Method:
+CC    Pointing the common variables on these of the current grid.  
+C
+C     Declarations:
+C        
+
+C
+C
+
+C
+C     Pointer argument: 
+      Type(Agrif_Grid), Pointer :: Agrif_Gr   ! Pointer on the current grid  
+C 
+C
+      Agrif_Curgrid => Agrif_Gr
+      Agrif_tabvars => Agrif_Curgrid % tabvars
+C
+      Call Agrif_Get_numberofcells(Agrif_Gr)
+C
+C
+C     Calculation of isf,jsf,nzsf and of the index of the output file 
+      Call Agrif_InitWorkSpace() 
+C
+C 
+      End Subroutine Agrif_Instance
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_initialisations  
+C     **************************************************************************
+      Subroutine Agrif_initialisations(Agrif_Gr)
+C
+CCC   Description:
+C
+CC    Method:
+C
+C     Declarations:
+C        
+      INTEGER :: i
+C
+C     Pointer argument: 
+      Type(Agrif_Grid), Pointer  :: Agrif_Gr
+      
+C
+      do i = 1 , Agrif_NbVariables
+C 
+         Agrif_Gr % tabvars(i) % var % nbdim = 0
+C
+         if (allocated(Agrif_Gr%tabvars(i)%var%array1)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 1
+             Agrif_Gr % tabvars(i) % var % lb(1:1) = 
+     &         lbound(Agrif_Gr%tabvars(i)%var%array1)
+             Agrif_Gr % tabvars(i) % var % ub(1:1) = 
+     &         ubound(Agrif_Gr%tabvars(i)%var%array1)     
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%array2)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 2
+             Agrif_Gr % tabvars(i) % var % lb(1:2) = 
+     &         lbound(Agrif_Gr%tabvars(i)%var%array2)
+             Agrif_Gr % tabvars(i) % var % ub(1:2) = 
+     &         ubound(Agrif_Gr%tabvars(i)%var%array2)
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%array3)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 3
+             Agrif_Gr % tabvars(i) % var % lb(1:3) = 
+     &         lbound(Agrif_Gr%tabvars(i)%var%array3)
+             Agrif_Gr % tabvars(i) % var % ub(1:3) = 
+     &         ubound(Agrif_Gr%tabvars(i)%var%array3)
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%array4)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 4
+             Agrif_Gr % tabvars(i) % var % lb(1:4) = 
+     &         lbound(Agrif_Gr%tabvars(i)%var%array4)
+             Agrif_Gr % tabvars(i) % var % ub(1:4) = 
+     &         ubound(Agrif_Gr%tabvars(i)%var%array4)
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%array5)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 5
+             Agrif_Gr % tabvars(i) % var % lb(1:5) = 
+     &         lbound(Agrif_Gr%tabvars(i)%var%array5)
+             Agrif_Gr % tabvars(i) % var % ub(1:5) = 
+     &         ubound(Agrif_Gr%tabvars(i)%var%array5)
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%array6)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 6
+             Agrif_Gr % tabvars(i) % var % lb(1:6) = 
+     &         lbound(Agrif_Gr%tabvars(i)%var%array6)
+             Agrif_Gr % tabvars(i) % var % ub(1:6) = 
+     &         ubound(Agrif_Gr%tabvars(i)%var%array6)
+         endif
+C
+         if (allocated(Agrif_Gr%tabvars(i)%var%darray1)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 1
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%darray2)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 2
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%darray3)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 3
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%darray4)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 4
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%darray5)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 5
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%darray6)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 6
+         endif
+C
+         if (allocated(Agrif_Gr%tabvars(i)%var%larray1)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 1
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%larray2)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 2
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%larray3)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 3
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%larray4)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 4
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%larray5)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 5
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%larray6)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 6
+         endif
+C
+         if (allocated(Agrif_Gr%tabvars(i)%var%iarray1)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 1
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%iarray2)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 2
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%iarray3)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 3
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%iarray4)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 4
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%iarray5)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 5
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%iarray6)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 6
+         endif
+C
+         if (allocated(Agrif_Gr%tabvars(i)%var%carray1)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 1
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%carray2)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 2
+         endif
+C 
+      enddo
+C
+      Return
+C 
+C
+      End Subroutine Agrif_initialisations
+C 
+C
+      End Module AGRIF_Init 
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinitvars.F
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinitvars.F	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinitvars.F	(revision 8201)
@@ -0,0 +1,125 @@
+!
+! $Id: modinitvars.F 2528 2010-12-27 17:33:53Z rblod $
+!
+C     Agrif (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_Init_Vars
+C
+      Module Agrif_Init_Vars
+C
+CCC   Description:
+CCC   Initialization of the variables of the current grid.
+C
+C     Modules used: 
+C      
+      Use Agrif_Types
+      Use Agrif_link
+C   
+      IMPLICIT NONE
+C
+      Contains
+C     Defininition of the procedures contained in this module 
+C  
+C 
+C     **************************************************************************
+CCC   Subroutine Agrif_Create_var 
+C     **************************************************************************
+C  
+      Subroutine Agrif_Create_Var(Agrif_Gr)
+C
+CCC   Description:
+CCC   Allocation of the field "var" of the grid variables.
+CCC   Fields "root_var", "nbdim" and "parent_var" of the grid variables.
+CCC   Array "tabvars" of the current grid. 
+C
+CC    Method:                  
+C 
+C     Declarations:
+C
+      
+C
+C     Pointer argument:
+      TYPE(Agrif_Grid),pointer   :: Agrif_Gr  ! Pointer on the current grid
+      INTEGER :: nb
+C
+C     Array "tabvars" of the current grid. 
+C
+      Allocate(Agrif_Gr % tabvars(Agrif_NbVariables))
+C      
+      do nb = 1, Agrif_NbVariables
+        Allocate(Agrif_Gr % tabvars(nb) % var)
+      enddo
+
+C     Fields "root_var", "nbdim" and "parent_var" of the grid variables.     
+      if (Agrif_Gr % fixedrank .NE.0) then
+         do nb = 1, Agrif_NbVariables     
+            Agrif_Gr % tabvars(nb) % parent_var => 
+     &      Agrif_Gr % parent %tabvars(nb)
+            Agrif_Gr % tabvars(nb) % var % nbdim =
+     &      Agrif_Mygrid % tabvars(nb) % var % nbdim
+            Agrif_Gr % tabvars(nb) % var % root_var =>
+     &      Agrif_Mygrid % tabvars(nb) % var          
+         enddo
+      endif
+C           
+      End Subroutine Agrif_Create_Var
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_CreateVar
+C     **************************************************************************
+C 
+      Subroutine Agrif_CreateVar(Agrif_Gr)            
+C
+CCC   Description:
+CCC   This subroutine allows to make a link between Mygrid and the current grid 
+C
+C     Modules used:
+C      
+C
+C     Declarations:
+C      
+C
+C
+C     Arguments      
+C
+      TYPE(Agrif_Grid),pointer   :: Agrif_Gr    ! Pointer on the current grid
+      INTEGER                    :: i           ! Loop
+C
+      if (Agrif_Gr % fixedrank .NE. 0) then
+C  
+         do i = 1 , Agrif_NbVariables 
+            Agrif_Gr % tabvars(i) % parent_var => 
+     &      Agrif_Gr % parent % tabvars(i) 
+            Agrif_Gr % tabvars(i) % var % root_var => 
+     &      Agrif_Mygrid % tabvars(i) % var
+            Agrif_Gr % tabvars(i) % var % nbdim  = 
+     &      Agrif_Gr % parent % tabvars(i) % var % nbdim
+         enddo 
+C	 
+      endif 
+C       
+      End Subroutine Agrif_CreateVar
+C
+C
+C
+      End Module Agrif_Init_Vars
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F	(revision 8201)
@@ -0,0 +1,2270 @@
+!
+! $Id: modinterp.F 2731 2011-04-08 12:05:35Z rblod $
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_Interpolation
+C
+      Module Agrif_Interpolation
+C
+CCC   Description:
+CCC   Module to initialize a fine grid from its parent grid, by using a space 
+CCC   interpolation
+C
+C     Modules used:
+C  
+      Use Agrif_Interpbasic
+      Use Agrif_Arrays
+      Use Agrif_Mask 
+      Use Agrif_CurgridFunctions
+#if defined key_mpp_mpi
+      Use Agrif_mpp
+#endif
+C      
+      IMPLICIT NONE
+      logical,  private:: precomputedone(7) = .FALSE.
+C
+      CONTAINS
+C     Define procedures contained in this module        
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_1d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_1d(TypeInterp,parent,child,tab,
+     &    torestore,nbdim,procname)            
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions of a fine grid for a 1D
+C        grid variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
+                                             !    (linear,lagrange,spline)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+                                             !    grid
+      LOGICAL :: torestore
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1)
+     &         ), Target :: tab    ! Result
+      External :: procname
+      Optional ::  procname
+C
+C
+      allocate(childtemp % var)  
+C      
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C      
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = nbdim
+C
+C     Tab is the result of the interpolation
+      childtemp % var % parray1 => tab 
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub  
+            
+C      
+      if (torestore) then
+C 
+          childtemp % var % parray1 = child % var % array1
+C          
+          childtemp % var % restore1D => child % var % restore1D
+C      
+        else
+C        
+          Nullify(childtemp % var % restore1D)
+C      
+      endif     
+C 
+C     Index indicating (in the Agrif_Interp1D procedure) if a space
+C        interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex       
+      childtemp % var % Interpolationshouldbemade = 
+     &    child % var % Interpolationshouldbemade 
+      childtemp % var % list_interp => child % var% list_interp            
+C      
+      if (present(procname)) then
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore,procname)
+      else
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore)
+      endif
+      child % var % list_interp => childtemp % var %list_interp     
+C      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_1D
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_2d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_2d(TypeInterp,parent,child,tab,
+     &                           torestore,nbdim,procname)            
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions of a fine grid for a 2D
+C        grid variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
+                                             !    (linear,lagrange,spline)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+                                             !    grid
+      LOGICAL :: torestore
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2)
+     &    ), Target :: tab    ! Result
+      External :: procname
+      Optional ::  procname
+C
+C
+      allocate(childtemp % var)  
+C      
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C      
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = nbdim
+C
+C     Tab is the result of the interpolation
+      childtemp % var % parray2 => tab  
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub
+      
+C
+      if (torestore) then      
+C 
+          childtemp % var % parray2 = child % var % array2          
+C 
+          childtemp % var % restore2D => child % var % restore2D        
+C      
+        else
+C        
+          Nullify(childtemp % var % restore2D)
+C      
+      endif       
+C 
+C     Index indicating (in the Agrif_Interp2D procedure) if a space
+C        interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex       
+      childtemp % var % Interpolationshouldbemade = 
+     &    child % var % Interpolationshouldbemade   
+      childtemp % var % list_interp => child % var% list_interp          
+C     
+      if (present(procname)) then
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore,procname)
+      else
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore)
+      endif
+
+      child % var % list_interp => childtemp % var %list_interp     
+C      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_2D
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_3d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_3d(TypeInterp,parent,child,tab,
+     &   torestore,nbdim,procname)            
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions of a fine grid for a 3D
+C        grid variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
+                                             !    (linear,lagrange,spline)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+                                             !    grid
+      LOGICAL :: torestore
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3)
+     &      ), Target :: tab  ! Results
+      External :: procname
+      Optional ::  procname
+C
+C
+      allocate(childtemp % var)  
+C
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C      
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = nbdim  
+C     
+C     Tab is the result of the interpolation 
+      childtemp % var % parray3 => tab 
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub        
+C      
+      if (torestore) then
+C     
+          childtemp % var % parray3 = child % var % array3
+C
+          childtemp % var % restore3D => child % var % restore3D
+C      
+        else
+C        
+          Nullify(childtemp % var % restore3D)
+C      
+      endif
+C 
+C     Index indicating (in the Agrif_Interp3D procedure) if a space
+C        interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex    
+      childtemp % var % Interpolationshouldbemade = 
+     &    child % var % Interpolationshouldbemade   
+      childtemp % var % list_interp => child % var% list_interp          
+C     
+
+      if (present(procname)) then
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore,procname)
+      else
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore)
+      endif
+
+
+      child % var % list_interp => childtemp % var %list_interp     
+C      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_3D               
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_4d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_4d(TypeInterp,parent,child,tab,
+     &   torestore,nbdim,procname)            
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions of a fine grid for a 4D
+C        grid variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
+                                             !    (linear,lagrange,spline)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+                                             !    grid
+      LOGICAL :: torestore
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3),
+     &         child%var%lb(4):child%var%ub(4)
+     &      ), Target :: tab  ! Results
+      External :: procname
+      Optional ::  procname
+C
+C
+      allocate(childtemp % var)  
+C
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C      
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = nbdim  
+C      
+C     Tab is the result of the interpolation
+      childtemp % var % parray4 => tab 
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub  
+            
+C 
+      if (torestore) then
+C 
+          childtemp % var % parray4 = child % var % array4
+C
+          childtemp % var % restore4D => child % var % restore4D
+C      
+        else
+C        
+          Nullify(childtemp % var % restore4D)
+C      
+      endif        
+C 
+C     Index indicating (in the Agrif_Interp4D procedure) if a space
+C        interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex    
+      childtemp % var % Interpolationshouldbemade = 
+     &    child % var % Interpolationshouldbemade  
+      childtemp % var % list_interp => child % var% list_interp           
+C     
+      if (present(procname)) then
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore,procname)
+      else
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore)
+      endif
+
+
+      child % var % list_interp => childtemp % var %list_interp
+C      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_4D
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_5d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_5d(TypeInterp,parent,child,tab,
+     &   torestore,nbdim,procname)            
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions of a fine grid for a 5D
+C        grid variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
+                                             !    (linear,lagrange,spline)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+                                             !    grid
+      LOGICAL :: torestore
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3),
+     &         child%var%lb(4):child%var%ub(4),
+     &         child%var%lb(5):child%var%ub(5)
+     &      ),  Target :: tab  ! Results
+      External :: procname
+      Optional ::  procname
+C
+C
+      allocate(childtemp % var)  
+C
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C      
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = nbdim  
+C      
+C     Tab is the result of the interpolation
+      childtemp % var % parray5 => tab  
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub  
+            
+C      
+      if (torestore) then
+C 
+          childtemp % var % parray5 = child % var % array5
+C
+          childtemp % var % restore5D => child % var % restore5D
+C      
+        else
+C        
+          Nullify(childtemp % var % restore5D)
+C      
+      endif       
+C 
+C     Index indicating (in the Agrif_Interp5D procedure) if a space
+C        interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex    
+      childtemp % var % Interpolationshouldbemade = 
+     &    child % var % Interpolationshouldbemade   
+      childtemp % var % list_interp => child % var% list_interp          
+C      
+      if (present(procname)) then
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore,procname)
+      else
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore)
+      endif
+
+     
+      child % var % list_interp => childtemp % var %list_interp
+C      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_5D
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_6d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_6d(TypeInterp,parent,child,tab,
+     &  torestore,nbdim,procname)            
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions of a fine grid for a 6D
+C        grid variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
+                                             !    (linear,lagrange,spline)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+                                             !    grid
+      LOGICAL :: torestore
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3),
+     &         child%var%lb(4):child%var%ub(4),
+     &         child%var%lb(5):child%var%ub(5),
+     &         child%var%lb(6):child%var%ub(6)
+     &      ),  Target :: tab  ! Results
+      External :: procname
+      Optional ::  procname
+C
+C
+      allocate(childtemp % var)  
+C
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C      
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = nbdim  
+C      
+C     Tab is the result of the interpolation
+      childtemp % var % parray6 => tab  
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub  
+            
+C      
+      if (torestore) then
+C 
+          childtemp % var % parray6 = child % var % array6
+C
+          childtemp % var % restore6D => child % var % restore6D
+C      
+        else
+C        
+          Nullify(childtemp % var % restore6D)
+C      
+      endif       
+C 
+C     Index indicating (in the Agrif_Interp6D procedure) if a space
+C        interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex    
+      childtemp % var % Interpolationshouldbemade = 
+     &    child % var % Interpolationshouldbemade  
+     
+      childtemp % var % list_interp => child % var% list_interp           
+C      
+
+      if (present(procname)) then
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore,procname)
+      else
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore)
+      endif
+
+
+C      
+      child % var % list_interp => childtemp % var %list_interp
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_6D
+C
+C
+C
+C     **************************************************************************
+C     Subroutine Agrif_InterpVariable    
+C     **************************************************************************
+C   
+      Subroutine Agrif_InterpVariable(TYPEinterp,parent,child,torestore,
+     &            procname)
+C
+CCC   Description:
+CCC   Subroutine to set some arguments of subroutine Agrif_InterpnD, n being the
+CCC   DIMENSION of the grid variable.
+C
+CC    Declarations:
+C      
+c      
+C      
+C
+C     Scalar argument
+      INTEGER,DIMENSION(6) :: TYPEinterp! TYPE of interpolation
+                                        !    (linear,spline,...)
+C     Data TYPE arguments                                   
+      TYPE(AGRIF_PVariable) :: parent   ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child    ! Variable on the child grid
+C
+C     LOGICAL argument      
+      LOGICAL:: torestore               ! Its value is .false., it indicates the
+                                        ! results of the interpolation are    
+                                        ! applied on the whole current grid   
+C
+C     Local scalars      
+      INTEGER               :: nbdim          ! Number of dimensions of the
+                                              !    current grid
+      INTEGER ,DIMENSION(6) :: pttab_child  
+      INTEGER ,DIMENSION(6) :: petab_child      
+      INTEGER ,DIMENSION(6) :: pttab_parent  
+      REAL    ,DIMENSION(6) :: s_child,s_parent
+      REAL    ,DIMENSION(6) :: ds_child,ds_parent
+      External :: procname
+      Optional ::  procname
+
+C
+      Call PreProcessToInterpOrUpdate(parent,child,
+     &             petab_Child(1:nbdim),
+     &             pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
+     &             s_Child(1:nbdim),s_Parent(1:nbdim),
+     &             ds_Child(1:nbdim),ds_Parent(1:nbdim),
+     &             nbdim)
+C
+C
+C     Call to a procedure of interpolation against the number of dimensions of 
+C     the grid variable
+C
+
+      if (present(procname)) then
+      call Agrif_InterpnD
+     &            (TYPEinterp,parent,child,
+     &             pttab_Child(1:nbdim),petab_Child(1:nbdim),
+     &             pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
+     &             s_Child(1:nbdim),s_Parent(1:nbdim),
+     &             ds_Child(1:nbdim),ds_Parent(1:nbdim),
+     &             child,torestore,nbdim,procname)
+      else
+      call Agrif_InterpnD
+     &            (TYPEinterp,parent,child,
+     &             pttab_Child(1:nbdim),petab_Child(1:nbdim),
+     &             pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
+     &             s_Child(1:nbdim),s_Parent(1:nbdim),
+     &             ds_Child(1:nbdim),ds_Parent(1:nbdim),
+     &             child,torestore,nbdim)
+
+      endif
+C
+      Return
+C
+C
+      End subroutine Agrif_InterpVariable       
+C
+C
+C     **************************************************************************
+C     Subroutine Agrif_InterpnD  
+C     **************************************************************************
+C  
+      Subroutine Agrif_InterpnD(TYPEinterp,parent,child,
+     &                          pttab,petab,
+     &                          pttab_Child,pttab_Parent,
+     &                          s_Child,s_Parent,ds_Child,ds_Parent,
+     &                          restore,torestore,nbdim,procname)
+C
+C     Description:
+C     Subroutine to interpolate a nD grid variable from its parent grid,
+C     by using a space interpolation. 
+C
+C     Declarations:
+C
+      
+C
+#ifdef key_mpp_mpi
+C
+        INCLUDE 'mpif.h'
+C
+#endif
+C
+C     Arguments
+      External :: procname
+      Optional :: procname
+      INTEGER                    :: nbdim
+      INTEGER,DIMENSION(6)       :: TYPEinterp         ! TYPE of interpolation
+                                                       !    (linear,...)
+      TYPE(AGRIF_PVARIABLE)      :: parent             ! Variable of the parent
+                                                       !    grid
+      TYPE(AGRIF_PVARIABLE)      :: child              ! Variable of the child
+                                                       !    grid
+      INTEGER,DIMENSION(nbdim)   :: pttab              ! Index of the first
+                                                       !    point inside the
+                                                       !    domain
+      INTEGER,DIMENSION(nbdim)   :: petab              ! Index of the first
+                                                       !    point inside the
+                                                       !    domain
+      INTEGER,DIMENSION(nbdim)   :: pttab_Child        ! Index of the first
+                                                       !    point inside the
+                                                       !    domain for the child
+                                                       !    grid variable
+      INTEGER,DIMENSION(nbdim)   :: pttab_Parent       ! Index of the first
+                                                       !    point inside the
+                                                       !    domain for the
+                                                       !    parent grid variable
+      TYPE(AGRIF_PVARIABLE)      :: restore            ! Indicates points where
+                                                       !    interpolation
+      REAL,DIMENSION(nbdim)      :: s_Child,s_Parent   ! Positions of the parent
+                                                       !    and child grids
+      REAL,DIMENSION(nbdim)      :: ds_Child,ds_Parent ! Space steps of the
+                                                       !    parent and child
+                                                       !    grids
+      LOGICAL                        :: torestore      ! Indicates if the array
+                                                       !    restore is used
+C
+C     Local pointers
+      TYPE(AGRIF_PVARIABLE),SAVE      :: tempP,tempPextend  ! Temporary parent grid variable
+      TYPE(AGRIF_PVARIABLE),SAVE      :: tempC      ! Temporary child grid variable
+C
+C     Local scalars        
+      INTEGER                     :: i,j,k,l,m,n
+      INTEGER,DIMENSION(nbdim)    :: pttruetab,cetruetab
+      INTEGER,DIMENSION(nbdim)    :: indmin,indmax
+      LOGICAL,DIMENSION(nbdim)    :: noraftab
+      REAL   ,DIMENSION(nbdim)    :: s_Child_temp,s_Parent_temp
+      INTEGER,DIMENSION(nbdim)    :: lowerbound,upperbound
+      INTEGER,DIMENSION(nbdim)    :: indminglob,indmaxglob
+      INTEGER,DIMENSION(nbdim,2,2) :: childarray
+      INTEGER,DIMENSION(nbdim,2,2) :: parentarray
+      LOGICAL :: memberin,member
+      TYPE(AGRIF_PVARIABLE),SAVE                      ::  parentvalues
+      LOGICAL :: find_list_interp
+      INTEGER,DIMENSION(nbdim)    :: indminglob2,indmaxglob2      
+C
+#ifdef key_mpp_mpi
+C
+      LOGICAL :: memberout
+      INTEGER,PARAMETER                          :: etiquette = 100
+      INTEGER                                    :: code
+      INTEGER,DIMENSION(nbdim,4)           :: tab3
+      INTEGER,DIMENSION(nbdim,4,0:Agrif_Nbprocs-1) :: tab4
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
+      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall
+      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1
+      LOGICAL, DIMENSION(1) :: memberin1
+C
+#endif      
+C     
+
+C   
+C     Boundaries of the current grid where interpolation is done
+
+      IF (Associated(child%var%list_interp)) THEN
+      Call Agrif_Find_list_interp(child%var%list_interp,pttab,petab,
+     &                          pttab_Child,pttab_Parent,nbdim,
+     &                          indmin,indmax,indminglob,
+     &       indmaxglob,indminglob2,indmaxglob2,parentarray,
+     &       pttruetab,cetruetab,member,memberin,find_list_interp
+#if defined key_mpp_mpi
+     &       ,tab4t,memberinall,sendtoproc1,recvfromproc1
+#endif
+     &    )
+      ELSE
+      find_list_interp = .FALSE.
+      ENDIF
+      
+      IF (.not.find_list_interp) THEN
+
+      Call Agrif_nbdim_Get_bound_dimension(child % var,
+     &                               lowerbound,upperbound,nbdim)
+      
+      Call Agrif_Childbounds(nbdim,lowerbound,upperbound,
+     &                                   pttab,petab,
+     &                                   pttruetab,cetruetab,memberin)
+     
+C
+      Call Agrif_Parentbounds(TYPEinterp,nbdim,indminglob,indmaxglob,
+     &                        s_Parent_temp,s_Child_temp,
+     &                        s_Child,ds_Child,
+     &                        s_Parent,ds_Parent,
+     &                        pttab,petab,
+     &                        pttab_Child,pttab_Parent,
+     &                        child%var%root_var%posvar,
+     &                        child % var % root_var % interptab)
+       
+#ifdef key_mpp_mpi
+       IF (memberin) THEN
+        Call Agrif_Parentbounds(TYPEinterp,nbdim,indmin,indmax,
+     &                        s_Parent_temp,s_Child_temp,
+     &                        s_Child,ds_Child,
+     &                        s_Parent,ds_Parent,
+     &                        pttruetab,cetruetab,
+     &                        pttab_Child,pttab_Parent,
+     &                        child%var%root_var%posvar,
+     &                        child % var % root_var % interptab)
+      ENDIF
+       
+      Call Agrif_nbdim_Get_bound_dimension(parent%var,
+     &                              lowerbound,upperbound,nbdim)
+       
+      Call Agrif_ChildGrid_to_ParentGrid()
+C
+      Call Agrif_Childbounds(nbdim,
+     &                       lowerbound,upperbound,
+     &                       indminglob,indmaxglob,
+     &                       indminglob2,indmaxglob2,member)
+
+C
+      IF (member) THEN
+      Call Agrif_GlobtoLocInd2(parentarray,
+     &                     lowerbound,upperbound,
+     &                     indminglob2,indmaxglob2,
+     &                     nbdim,Agrif_Procrank,
+     &                     member)
+       endif
+       
+      Call Agrif_ParentGrid_to_ChildGrid()
+#else
+      parentarray(:,1,1) = indminglob
+      parentarray(:,2,1) = indmaxglob
+      parentarray(:,1,2) = indminglob
+      parentarray(:,2,2) = indmaxglob
+      indmin = indminglob
+      indmax = indmaxglob
+      member = .TRUE.
+#endif
+
+      ELSE
+      
+#if !defined key_mpp_mpi
+      parentarray(:,1,1) = indminglob
+      parentarray(:,2,1) = indmaxglob
+      parentarray(:,1,2) = indminglob
+      parentarray(:,2,2) = indmaxglob
+      indmin = indminglob
+      indmax = indmaxglob
+      member = .TRUE.
+      s_Parent_temp = s_Parent + (indminglob - pttab_Parent)*ds_Parent
+      s_Child_temp = s_Child + (pttab - pttab_Child) * ds_Child
+#else      
+      s_Parent_temp = s_Parent + (indmin - pttab_Parent)*ds_Parent
+      s_Child_temp = s_Child + (pttruetab - pttab_Child) * ds_Child
+#endif      
+           
+      ENDIF
+
+      IF (member) THEN
+      IF (.not.associated(tempP%var)) allocate(tempP%var)
+
+C
+      Call Agrif_nbdim_allocation(tempP%var,
+     &     parentarray(:,1,1),parentarray(:,2,1),nbdim)
+
+      Call Agrif_nbdim_Full_VarEQreal(tempP%var,0.,nbdim)
+
+      IF (present(procname)) THEN
+      Call Agrif_ChildGrid_to_ParentGrid()
+            SELECT CASE (nbdim)
+        CASE(1)
+          CALL procname(tempP%var%array1,
+     &                          parentarray(1,1,2),parentarray(1,2,2))
+        CASE(2)
+          CALL procname(tempP%var%array2,
+     &                          parentarray(1,1,2),parentarray(1,2,2),
+     &                          parentarray(2,1,2),parentarray(2,2,2))
+        CASE(3)
+          CALL procname(tempP%var%array3,
+     &                          parentarray(1,1,2),parentarray(1,2,2),
+     &                          parentarray(2,1,2),parentarray(2,2,2),
+     &                          parentarray(3,1,2),parentarray(3,2,2))
+        CASE(4)
+          CALL procname(tempP%var%array4,
+     &                          parentarray(1,1,2),parentarray(1,2,2),
+     &                          parentarray(2,1,2),parentarray(2,2,2),
+     &                          parentarray(3,1,2),parentarray(3,2,2),
+     &                          parentarray(4,1,2),parentarray(4,2,2))
+        CASE(5)
+          CALL procname(tempP%var%array5,
+     &                          parentarray(1,1,2),parentarray(1,2,2),
+     &                          parentarray(2,1,2),parentarray(2,2,2),
+     &                          parentarray(3,1,2),parentarray(3,2,2),
+     &                          parentarray(4,1,2),parentarray(4,2,2),
+     &                          parentarray(5,1,2),parentarray(5,2,2))
+        CASE(6)
+          CALL procname(tempP%var%array6,
+     &                          parentarray(1,1,2),parentarray(1,2,2),
+     &                          parentarray(2,1,2),parentarray(2,2,2),
+     &                          parentarray(3,1,2),parentarray(3,2,2),
+     &                          parentarray(4,1,2),parentarray(4,2,2),
+     &                          parentarray(5,1,2),parentarray(5,2,2),
+     &                          parentarray(6,1,2),parentarray(6,2,2))
+            END SELECT
+      Call Agrif_ParentGrid_to_ChildGrid()
+      ELSE
+
+      Call Agrif_nbdim_VarEQvar(tempP%var,
+     &        parentarray(:,1,1),parentarray(:,2,1),
+     &        parent%var,parentarray(:,1,2),parentarray(:,2,2),
+     &        nbdim)
+      ENDIF
+            endif
+
+#ifdef key_mpp_mpi
+      if (.not.find_list_interp) then
+      tab3(:,1) = indminglob2(:)
+      tab3(:,2) = indmaxglob2(:)
+      tab3(:,3) = indmin(:)
+      tab3(:,4) = indmax(:)
+C
+C
+      Call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,
+     &                   MPI_INTEGER,MPI_COMM_AGRIF,code)
+
+      IF (.not.associated(tempPextend%var)) Allocate(tempPextend%var)
+
+      DO k=0,Agrif_Nbprocs-1
+       do j=1,4
+         do i=1,nbdim
+         tab4t(i,k,j) = tab4(i,j,k)
+                enddo
+      enddo
+      enddo
+      
+      memberin1(1) = memberin
+      CALL MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall,
+     &                  1,MPI_LOGICAL,MPI_COMM_AGRIF,code)
+
+       Call Get_External_Data_first(tab4t(:,:,1),
+     &            tab4t(:,:,2),
+     &            tab4t(:,:,3),tab4t(:,:,4),nbdim,member,memberin,
+     &            memberinall,sendtoproc1,recvfromproc1,tab4t(:,:,5),
+     & tab4t(:,:,6),tab4t(:,:,7),tab4t(:,:,8))
+          
+      endif     
+           
+!      Call Get_External_Data(tempP,tempPextend,tab4t(:,:,1),
+!     &            tab4t(:,:,2),
+!     &            tab4t(:,:,3),tab4t(:,:,4),nbdim,member,memberin,
+!     &            memberinall)
+     
+      Call ExchangeSameLevel2(sendtoproc1,recvfromproc1,nbdim,
+     &            tab4t(:,:,3),tab4t(:,:,4),tab4t(:,:,5),tab4t(:,:,6),
+     &            tab4t(:,:,7),tab4t(:,:,8),memberin,tempP,
+     &            tempPextend)
+#else
+      tempPextend%var => tempP%var
+#endif
+
+      if (.not.find_list_interp) then
+      Call Agrif_Addto_list_interp(child%var%list_interp,pttab,petab,
+     &                          pttab_Child,pttab_Parent,indmin,indmax,
+     &   indminglob,indmaxglob,indminglob2,indmaxglob2,parentarray,
+     &   pttruetab,cetruetab,member,memberin,nbdim
+#if defined key_mpp_mpi
+     &   ,tab4t,memberinall,sendtoproc1,recvfromproc1
+#endif
+     &    )
+      endif   
+C
+C
+      IF (memberin) THEN
+      IF (.not.associated(tempC%var)) allocate(tempC%var)
+C
+
+      Call Agrif_nbdim_allocation(tempC%var,pttruetab,cetruetab,nbdim)
+
+C
+C
+C     Special values on the parent grid
+      if (Agrif_UseSpecialValue) then
+C
+          noraftab(1:nbdim) =
+     &         child % var % root_var % interptab(1:nbdim) .EQ. 'N'
+C
+          IF (.not.associated(parentvalues%var))
+     &            Allocate(parentvalues%var)
+C
+          Call Agrif_nbdim_allocation
+     &               (parentvalues%var,indmin,indmax,nbdim)
+          Call Agrif_nbdim_Full_VarEQvar
+     &               (parentvalues%var,tempPextend%var,nbdim)
+C
+          Call Agrif_CheckMasknD(tempPextend,
+     &                           parentvalues,
+     &                           indmin(1:nbdim),indmax(1:nbdim),
+     &                           indmin(1:nbdim),indmax(1:nbdim),
+     &                           noraftab(1:nbdim),nbdim)
+C
+          Call Agrif_nbdim_deallocation(parentvalues%var,nbdim)
+C          Deallocate(parentvalues%var)
+C
+C
+      endif      
+
+C
+C
+C     Interpolation of the current grid
+
+      IF (memberin) THEN
+      if ( nbdim .EQ. 1 ) then
+         Call Agrif_Interp_1D_recursive(TypeInterp,
+     &           tempPextend%var%array1,tempC%var%array1,
+     &           indmin,indmax,
+     &           pttruetab,cetruetab,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+      elseif ( nbdim .EQ. 2 ) then
+
+         Call Agrif_Interp_2D_recursive(TypeInterp,
+     &           tempPextend%var%array2,tempC%var%array2,
+     &           indmin,indmax,
+     &           pttruetab,cetruetab,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+      elseif ( nbdim .EQ. 3 ) then
+
+         Call Agrif_Interp_3D_recursive(TypeInterp,
+     &           tempPextend%var%array3,tempC%var%array3,
+     &           indmin,indmax,
+     &           pttruetab,cetruetab,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+      elseif ( nbdim .EQ. 4 ) then
+         Call Agrif_Interp_4D_recursive(TypeInterp,
+     &           tempPextend%var%array4,tempC%var%array4,
+     &           indmin,indmax,
+     &           pttruetab,cetruetab,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+      elseif ( nbdim .EQ. 5 ) then
+         Call Agrif_Interp_5D_recursive(TypeInterp,
+     &           tempPextend%var%array5,tempC%var%array5,
+     &           indmin,indmax,
+     &           pttruetab,cetruetab,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+      elseif ( nbdim .EQ. 6 ) then
+         Call Agrif_Interp_6D_recursive(TypeInterp,
+     &           tempPextend%var%array6,tempC%var%array6,
+     &           indmin,indmax,
+     &           pttruetab,cetruetab,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+       endif
+
+
+C  
+
+      Call Agrif_nbdim_Get_bound_dimension(child % var,
+     &                               lowerbound,upperbound,nbdim)
+
+#ifdef key_mpp_mpi
+      Call Agrif_GlobtoLocInd2(childarray,
+     &                     lowerbound,upperbound,
+     &                     pttruetab,cetruetab,
+     &                     nbdim,Agrif_Procrank,
+     &                     memberout)
+
+#else
+       childarray(:,1,1) = pttruetab
+       childarray(:,2,1) = cetruetab
+       childarray(:,1,2) = pttruetab
+       childarray(:,2,2) = cetruetab
+ccccccccccccccc       memberout = .TRUE.
+#endif
+
+
+C
+C
+C     Special values on the child grid  
+      if (Agrif_UseSpecialValueFineGrid) then
+C
+
+          Call GiveAgrif_SpecialValueToTab_mpi(child%var,tempC%var,
+     &                 childarray,
+     &                 pttruetab,cetruetab,
+     &                 Agrif_SpecialValueFineGrid,nbdim)
+
+C        
+      endif
+      
+      endif
+
+C
+      if (torestore) then
+C
+#ifdef key_mpp_mpi
+C
+        SELECT CASE (nbdim)
+        CASE (1)
+             do i = pttruetab(1),cetruetab(1)         
+ChildarrayAModifier                if (restore%var%restore1D(i) == 0) 
+ChildarrayAModifier     &                child%var%array1(childarray(i,1,2)
+ChildarrayAModifier     &                                 ) = 
+ChildarrayAModifier     &                tempC%var%array1(i)
+             enddo
+        CASE (2)
+             do i = pttruetab(1),cetruetab(1)
+             do j = pttruetab(2),cetruetab(2)
+ChildarrayAModifier                   if (restore%var%restore2D(i,j) == 0) 
+ChildarrayAModifier     &                child%var%array2(childarray(i,1,2),
+ChildarrayAModifier     &                                 childarray(j,2,2)) = 
+ChildarrayAModifier     &                tempC%var%array2(i,j)
+             enddo
+             enddo
+        CASE (3)
+             do i = pttruetab(1),cetruetab(1)
+             do j = pttruetab(2),cetruetab(2)  
+             do k = pttruetab(3),cetruetab(3)
+ChildarrayAModifier                      if (restore%var%restore3D(i,j,k) == 0) 
+ChildarrayAModifier     &                child%var%array3(childarray(i,1,2),
+ChildarrayAModifier     &                                 childarray(j,2,2),
+ChildarrayAModifier     &                                 childarray(k,3,2)) = 
+ChildarrayAModifier     &                tempC%var%array3(i,j,k)
+             enddo
+             enddo
+             enddo
+        CASE (4)
+             do i = pttruetab(1),cetruetab(1)
+             do j = pttruetab(2),cetruetab(2)
+             do k = pttruetab(3),cetruetab(3)
+             do l = pttruetab(4),cetruetab(4)
+ChildarrayAModifier                         if (restore%var%restore4D(i,j,k,l) == 0) 
+ChildarrayAModifier     &                      child%var%array4(childarray(i,1,2),
+ChildarrayAModifier     &                                       childarray(j,2,2),
+ChildarrayAModifier     &                                       childarray(k,3,2),
+ChildarrayAModifier     &                                       childarray(l,4,2)) = 
+ChildarrayAModifier     &                      tempC%var%array4(i,j,k,l)
+             enddo
+             enddo
+             enddo
+             enddo
+        CASE (5)
+             do i = pttruetab(1),cetruetab(1)
+             do j = pttruetab(2),cetruetab(2)
+             do k = pttruetab(3),cetruetab(3)
+             do l = pttruetab(4),cetruetab(4)
+             do m = pttruetab(5),cetruetab(5)
+ChildarrayAModifier              if (restore%var%restore5D(i,j,k,l,m) == 0) 
+ChildarrayAModifier     &                child%var%array5(childarray(i,1,2),
+ChildarrayAModifier     &                                 childarray(j,2,2),
+ChildarrayAModifier     &                                 childarray(k,3,2),
+ChildarrayAModifier     &                                 childarray(l,4,2),
+ChildarrayAModifier     &                                 childarray(m,5,2)) = 
+ChildarrayAModifier     &                tempC%var%array5(i,j,k,l,m)
+             enddo
+             enddo
+             enddo
+             enddo
+             enddo
+        CASE (6)
+             do i = pttruetab(1),cetruetab(1)
+             do j = pttruetab(2),cetruetab(2)
+             do k = pttruetab(3),cetruetab(3)
+             do l = pttruetab(4),cetruetab(4)
+             do m = pttruetab(5),cetruetab(5)
+             do n = pttruetab(6),cetruetab(6)
+ChildarrayAModifier              if (restore%var%restore6D(i,j,k,l,m,n) == 0) 
+ChildarrayAModifier     &                child%var%array6(childarray(i,1,2),
+ChildarrayAModifier     &                                 childarray(j,2,2),
+ChildarrayAModifier     &                                 childarray(k,3,2),
+ChildarrayAModifier     &                                 childarray(l,4,2),
+ChildarrayAModifier     &                                 childarray(m,5,2),
+ChildarrayAModifier     &                                 childarray(n,6,2)) = 
+ChildarrayAModifier     &                tempC%var%array6(i,j,k,l,m,n)
+             enddo
+             enddo
+             enddo
+             enddo
+             enddo
+             enddo
+        END SELECT
+C
+#else
+        SELECT CASE (nbdim)
+        CASE (1)
+           do i = pttruetab(1),cetruetab(1)         
+            if (restore%var%restore1D(i) == 0)
+     &            child % var % parray1(i) = 
+     &            tempC % var % array1(i)    
+          enddo
+        CASE (2)
+           do j = pttruetab(2),cetruetab(2)
+             do i = pttruetab(1),cetruetab(1) 
+              if (restore%var%restore2D(i,j) == 0)     
+     &              child % var % parray2(i,j) = 
+     &              tempC % var % array2(i,j)    
+              enddo
+             enddo
+        CASE (3)
+           do k = pttruetab(3),cetruetab(3)
+           do j = pttruetab(2),cetruetab(2)
+             do i = pttruetab(1),cetruetab(1) 
+              if (restore%var%restore3D(i,j,k) == 0)
+     &                  child % var % parray3(i,j,k) =
+     &                  tempC % var % array3(i,j,k)    
+                  enddo
+              enddo
+             enddo
+        CASE (4)
+           do l = pttruetab(4),cetruetab(4)
+           do k = pttruetab(3),cetruetab(3)
+          do j = pttruetab(2),cetruetab(2)
+             do i = pttruetab(1),cetruetab(1)
+                if (restore%var%restore4D(i,j,k,l) == 0)
+     &                 child % var % parray4(i,j,k,l) = 
+     &                 tempC % var % array4(i,j,k,l)    
+             enddo
+             enddo
+              enddo
+             enddo
+        CASE (5)
+           do m = pttruetab(5),cetruetab(5)
+          do l = pttruetab(4),cetruetab(4)
+         do k = pttruetab(3),cetruetab(3)
+           do j = pttruetab(2),cetruetab(2)
+             do i = pttruetab(1),cetruetab(1)
+                if (restore%var%restore5D(i,j,k,l,m) == 0)
+     &                  child % var % parray5(i,j,k,l,m) = 
+     &                  tempC % var % array5(i,j,k,l,m)    
+             enddo
+             enddo
+                  enddo
+              enddo
+             enddo
+        CASE (6)
+           do n = pttruetab(6),cetruetab(6)
+          do m = pttruetab(5),cetruetab(5)
+          do l = pttruetab(4),cetruetab(4)
+         do k = pttruetab(3),cetruetab(3)
+          do j = pttruetab(2),cetruetab(2)
+             do i = pttruetab(1),cetruetab(1)
+                if (restore%var%restore6D(i,j,k,l,m,n) == 0)
+     &                      child % var % parray6(i,j,k,l,m,n) = 
+     &                      tempC % var % array6(i,j,k,l,m,n)    
+             enddo
+            enddo
+                      enddo
+                  enddo
+              enddo
+             enddo
+        END SELECT
+C
+#endif
+C        
+        else
+C
+C
+          IF (memberin) THEN
+          SELECT CASE (nbdim)
+          CASE (1)
+            child%var%parray1(childarray(1,1,2):childarray(1,2,2)) =
+     &       tempC%var%array1(childarray(1,1,1):childarray(1,2,1))
+          CASE (2)
+            child%var%parray2(childarray(1,1,2):childarray(1,2,2),
+     &                       childarray(2,1,2):childarray(2,2,2)) =
+     &      tempC%var%array2(childarray(1,1,1):childarray(1,2,1),
+     &                       childarray(2,1,1):childarray(2,2,1))
+          CASE (3)
+            child%var%parray3(childarray(1,1,2):childarray(1,2,2),
+     &                       childarray(2,1,2):childarray(2,2,2),
+     &                       childarray(3,1,2):childarray(3,2,2)) =
+     &      tempC%var%array3(childarray(1,1,1):childarray(1,2,1),
+     &                       childarray(2,1,1):childarray(2,2,1),
+     &                       childarray(3,1,1):childarray(3,2,1))
+          CASE (4)
+            child%var%parray4(childarray(1,1,2):childarray(1,2,2),
+     &                       childarray(2,1,2):childarray(2,2,2),
+     &                       childarray(3,1,2):childarray(3,2,2),
+     &                       childarray(4,1,2):childarray(4,2,2)) =
+     &      tempC%var%array4(childarray(1,1,1):childarray(1,2,1),
+     &                       childarray(2,1,1):childarray(2,2,1),
+     &                       childarray(3,1,1):childarray(3,2,1),
+     &                       childarray(4,1,1):childarray(4,2,1))
+          CASE (5)
+            child%var%parray5(childarray(1,1,2):childarray(1,2,2),
+     &                       childarray(2,1,2):childarray(2,2,2),
+     &                       childarray(3,1,2):childarray(3,2,2),
+     &                       childarray(4,1,2):childarray(4,2,2),
+     &                       childarray(5,1,2):childarray(5,2,2)) =
+     &      tempC%var%array5(childarray(1,1,1):childarray(1,2,1),
+     &                       childarray(2,1,1):childarray(2,2,1),
+     &                       childarray(3,1,1):childarray(3,2,1),
+     &                       childarray(4,1,1):childarray(4,2,1),
+     &                       childarray(5,1,1):childarray(5,2,1))
+          CASE (6)
+            child%var%parray6(childarray(1,1,2):childarray(1,2,2),
+     &                       childarray(2,1,2):childarray(2,2,2),
+     &                       childarray(3,1,2):childarray(3,2,2),
+     &                       childarray(4,1,2):childarray(4,2,2),
+     &                       childarray(5,1,2):childarray(5,2,2),
+     &                       childarray(6,1,2):childarray(6,2,2)) =
+     &      tempC%var%array6(childarray(1,1,1):childarray(1,2,1),
+     &                       childarray(2,1,1):childarray(2,2,1),
+     &                       childarray(3,1,1):childarray(3,2,1),
+     &                       childarray(4,1,1):childarray(4,2,1),
+     &                       childarray(5,1,1):childarray(5,2,1),
+     &                       childarray(6,1,1):childarray(6,2,1))
+          END SELECT
+          ENDIF
+C
+C       
+      endif
+
+        Call Agrif_nbdim_deallocation(tempPextend%var,nbdim)
+C        deallocate(tempPextend%var)
+
+      Call Agrif_nbdim_deallocation(tempC%var,nbdim)
+      
+C      Deallocate(tempC % var)
+      ELSE
+      
+C      deallocate(tempPextend%var)
+
+      ENDIF
+C
+C             
+C     Deallocations
+#ifdef key_mpp_mpi        
+      IF (member) THEN
+      Call Agrif_nbdim_deallocation(tempP%var,nbdim)
+C      Deallocate(tempP % var)
+      endif
+#endif
+C
+C
+      
+C
+C
+      End Subroutine Agrif_InterpnD 
+C
+C
+C
+C                  
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Parentbounds
+C     **************************************************************************
+C
+      Subroutine Agrif_Parentbounds(TYPEinterp,nbdim,indmin,indmax,
+     &                              s_Parent_temp,
+     &                              s_Child_temp,s_Child,ds_Child,
+     &                              s_Parent,ds_Parent,
+     &                              pttruetab,cetruetab,pttab_Child,
+     &                              pttab_Parent,posvar,interptab)
+C
+CCC   Description:
+CCC   Subroutine calculating the bounds of the parent grid for the interpolation
+CCC   of the child grid     
+C
+C
+C     Declarations:
+C
+C
+C     Arguments
+      INTEGER :: nbdim
+      INTEGER, DIMENSION(6) :: TypeInterp
+      INTEGER,DIMENSION(nbdim) :: indmin,indmax
+      REAL,DIMENSION(nbdim) :: s_Parent_temp,s_child_temp
+      REAL,DIMENSION(nbdim) :: s_Child,ds_child
+      REAL,DIMENSION(nbdim) :: s_Parent,ds_Parent
+      INTEGER,DIMENSION(nbdim) :: pttruetab,cetruetab
+      INTEGER,DIMENSION(nbdim) :: pttab_Child,pttab_Parent
+      INTEGER,DIMENSION(nbdim) :: posvar
+      CHARACTER(6), DIMENSION(nbdim) :: interptab
+C
+C     Local variables
+      INTEGER :: i
+      REAL,DIMENSION(nbdim) :: dim_newmin,dim_newmax      
+C
+      dim_newmin = s_Child + (pttruetab - pttab_Child) * ds_Child
+      dim_newmax = s_Child + (cetruetab - pttab_Child) * ds_Child
+      
+      DO i = 1,nbdim         
+C     
+        indmin(i) = pttab_Parent(i) + 
+     &         agrif_int((dim_newmin(i)-s_Parent(i))/ds_Parent(i))
+C
+        indmax(i) = pttab_Parent(i) + 
+     &                agrif_ceiling((dim_newmax(i)-
+     &                s_Parent(i))/ds_Parent(i))
+     
+C
+C
+C       Necessary for the Quadratic interpolation
+C  
+
+        IF ((pttruetab(i) == cetruetab(i)) .AND. 
+     &                           (posvar(i) == 1)) THEN
+        ELSEIF (interptab(i) .EQ. 'N') THEN
+        ELSEIF ( TYPEinterp(i) .eq. Agrif_ppm .or.
+     &      TYPEinterp(i) .eq. Agrif_eno  .or.
+     &      TYPEinterp(i) .eq. Agrif_weno) THEN            
+           indmin(i) = indmin(i) - 2  
+           indmax(i) = indmax(i) + 2                  
+        ELSE IF (( TYPEinterp(i) .ne. Agrif_constant )
+     &        .AND.( TYPEinterp(i) .ne. Agrif_linear )) THEN
+           indmin(i) = indmin(i) - 1  
+           indmax(i) = indmax(i) + 1
+        ENDIF
+        
+
+C        
+       ENDDO 
+C
+        s_Parent_temp = s_Parent + (indmin - pttab_Parent) * ds_Parent
+C     
+        s_Child_temp = s_Child + (pttruetab - pttab_Child) * ds_Child
+C
+C
+      Return
+C
+C
+      End Subroutine Agrif_Parentbounds
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_1D_Recursive 
+C     **************************************************************************
+C
+      Subroutine Agrif_Interp_1D_recursive(TypeInterp,tabin,tabout,
+     &           indmin,indmax, 
+     &           pttab_child,petab_child,
+     &           s_child,s_parent,ds_child,ds_parent,nbdim)     
+C
+CCC   Description:
+CCC   Subroutine for the interpolation of a 1D grid variable. 
+CCC   It calls Agrif_InterpBase. 
+C
+C     Declarations:
+C
+      
+C
+C     Arguments
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(1) :: TypeInterp
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL, DIMENSION(nbdim) :: s_child,s_parent
+      REAL, DIMENSION(nbdim) :: ds_child,ds_parent
+      REAL, INTENT(IN),DIMENSION(indmin(nbdim):indmax(nbdim)) :: tabin        
+      REAL, INTENT(OUT),
+     &      DIMENSION(pttab_child(nbdim):petab_child(nbdim)) :: tabout
+      INTEGER :: coeffraf
+C
+C
+C     Commentaire perso : nbdim vaut toujours 1 ici. 
+C
+      coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
+      
+      Call Agrif_InterpBase(TypeInterp(1),
+     &                  tabin(indmin(nbdim):indmax(nbdim)),
+     &                  tabout(pttab_child(nbdim):petab_child(nbdim)),
+     &                  indmin(nbdim),indmax(nbdim),            
+     &                  pttab_child(nbdim),petab_child(nbdim),
+     &                  s_parent(nbdim),s_child(nbdim),
+     &                  ds_parent(nbdim),ds_child(nbdim),coeffraf)
+                
+C                
+      Return
+C
+C
+      End Subroutine Agrif_Interp_1D_recursive
+C
+C
+C      
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_2D_Recursive 
+C     **************************************************************************
+C
+      Subroutine Agrif_Interp_2D_recursive(TypeInterp,
+     &           tabin,tabout,
+     &           indmin,indmax,   
+     &           pttab_child,petab_child,
+     &            s_child, s_parent,
+     &           ds_child,ds_parent,
+     &           nbdim)
+C
+CCC   Description:
+CCC   Subroutine for the interpolation of a 2D grid variable. 
+CCC   It calls Agrif_Interp_1D_recursive and Agrif_InterpBase.    
+C
+C     Declarations:
+C
+      
+C     
+      INTEGER                   :: nbdim
+      INTEGER,DIMENSION(2)      :: TypeInterp
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL   , DIMENSION(nbdim) ::  s_child, s_parent
+      REAL   , DIMENSION(nbdim) :: ds_child,ds_parent
+      REAL   ,INTENT(IN), DIMENSION(
+     &                indmin(nbdim-1):indmax(nbdim-1),
+     &                indmin(nbdim):indmax(nbdim)
+     &                ) :: tabin        
+      REAL   ,INTENT(OUT), DIMENSION(
+     &                pttab_child(nbdim-1):petab_child(nbdim-1),
+     &                pttab_child(nbdim):petab_child(nbdim)
+     &                ) :: tabout
+C
+C     Local variables      
+      REAL, DIMENSION(pttab_child(nbdim-1):petab_child(nbdim-1),
+     &                 indmin(nbdim):indmax(nbdim)) :: tabtemp
+      INTEGER i,j
+      INTEGER :: coeffraf
+      REAL   , DIMENSION(
+     &                pttab_child(nbdim):petab_child(nbdim),
+     &                pttab_child(nbdim-1):petab_child(nbdim-1)
+     &                ) :: tabout_trsp
+      REAL, DIMENSION(indmin(nbdim):indmax(nbdim),
+     &        pttab_child(nbdim-1):petab_child(nbdim-1)) :: tabtemp_trsp
+
+C
+C
+C
+C
+C     Commentaire perso : nbdim vaut toujours 2 ici.
+C
+      coeffraf = nint ( ds_parent(1) / ds_child(1) )
+      IF((TypeInterp(1) == Agrif_Linear) .AND. (coeffraf /= 1 ) )THEN
+
+!---CDIR NEXPAND
+          IF(.NOT. precomputedone(1) ) call linear1Dprecompute2D(
+     &          indmax(2)-indmin(2)+1,   
+     &          indmax(1)-indmin(1)+1,   
+     &          petab_child(1)-pttab_child(1)+1,
+     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+!---CDIR NEXPAND
+           call linear1daftercompute(tabin,tabtemp,
+     &          size(tabin), size(tabtemp),  
+     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+ 
+      ELSEIF((TypeInterp(1) == Agrif_PPM) .AND. (coeffraf /= 1 ) )THEN
+!---CDIR NEXPAND
+          IF(.NOT. precomputedone(1) ) call ppm1Dprecompute2D(
+     &          indmax(2)-indmin(2)+1,   
+     &          indmax(1)-indmin(1)+1,   
+     &          petab_child(1)-pttab_child(1)+1,
+     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+!---CDIR NEXPAND
+           call ppm1daftercompute(tabin,tabtemp,
+     &          size(tabin), size(tabtemp),  
+     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+
+      ELSE
+
+      do j = indmin(nbdim),indmax(nbdim)
+C        
+!---CDIR NEXPAND
+        Call Agrif_Interp_1D_recursive(TypeInterp(1),
+     &         tabin(indmin(nbdim-1):indmax(nbdim-1),j),
+     &         tabtemp(pttab_child(nbdim-1):petab_child(nbdim-1),j),
+     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
+     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
+     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
+     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
+C        
+      enddo
+      ENDIF   
+
+      coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
+      
+      tabtemp_trsp = TRANSPOSE(tabtemp)
+
+      IF((TypeInterp(2) == Agrif_Linear) .AND. (coeffraf /= 1 ) )THEN
+
+!---CDIR NEXPAND
+          IF(.NOT. precomputedone(2) ) call linear1Dprecompute2D(
+     &          petab_child(1)-pttab_child(1)+1,
+     &          indmax(2)-indmin(2)+1,
+     &          petab_child(2)-pttab_child(2)+1,
+     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+!---CDIR NEXPAND
+           call linear1daftercompute(tabtemp_trsp,tabout_trsp,
+     &          size(tabtemp_trsp), size(tabout_trsp),
+     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+
+      ELSEIF((TypeInterp(2) == Agrif_PPM) .AND. (coeffraf /= 1 ) )THEN
+
+!---CDIR NEXPAND
+           IF(.NOT. precomputedone(1) )call ppm1Dprecompute2D(
+     &          petab_child(1)-pttab_child(1)+1,
+     &          indmax(2)-indmin(2)+1,
+     &          petab_child(2)-pttab_child(2)+1,
+     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+!---CDIR NEXPAND
+           call ppm1daftercompute(tabtemp_trsp,tabout_trsp,
+     &          size(tabtemp_trsp), size(tabout_trsp),
+     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+
+      ELSE
+      do i=pttab_child(nbdim-1),petab_child(nbdim-1)
+C
+!---CDIR NEXPAND
+        Call Agrif_InterpBase(TypeInterp(2),
+     &           tabtemp_trsp(indmin(nbdim):indmax(nbdim),i),
+     &           tabout_trsp(pttab_child(nbdim):petab_child(nbdim),i),
+     &           indmin(nbdim),indmax(nbdim),
+     &           pttab_child(nbdim),petab_child(nbdim),
+     &           s_parent(nbdim),s_child(nbdim),
+     &           ds_parent(nbdim),ds_child(nbdim),coeffraf)
+
+C        
+      enddo
+      ENDIF
+      
+      tabout = TRANSPOSE(tabout_trsp)
+C
+      Return
+C
+C
+      End Subroutine Agrif_Interp_2D_recursive
+C
+C
+C      
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_3D_Recursive 
+C     **************************************************************************
+C
+      Subroutine Agrif_Interp_3D_recursive(TypeInterp,tabin,tabout,
+     &           indmin,indmax,   
+     &           pttab_child,petab_child,
+     &           s_child,s_parent,ds_child,ds_parent,nbdim)
+C
+CCC   Description:
+CCC   Subroutine for the interpolation of a 3D grid variable. 
+CCC   It calls Agrif_Interp_2D_recursive and Agrif_InterpBase.    
+C
+C     Declarations:
+C
+      
+C     
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(3) :: TypeInterp
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL, DIMENSION(nbdim) :: s_child,s_parent,ds_child,ds_parent
+      REAL,INTENT(IN), DIMENSION(indmin(nbdim-2):indmax(nbdim-2),
+     &                indmin(nbdim-1):indmax(nbdim-1),
+     &                indmin(nbdim)  :indmax(nbdim)) :: tabin        
+      REAL,INTENT(OUT),
+     &        DIMENSION(pttab_child(nbdim-2):petab_child(nbdim-2),
+     &                pttab_child(nbdim-1):petab_child(nbdim-1),
+     &                pttab_child(nbdim):petab_child(nbdim)) :: tabout
+C
+C     Local variables      
+      REAL, DIMENSION(pttab_child(nbdim-2):petab_child(nbdim-2),
+     &                 pttab_child(nbdim-1):petab_child(nbdim-1),
+     &                 indmin(nbdim):indmax(nbdim)) :: tabtemp
+      INTEGER i,j,k
+      INTEGER :: coeffraf, locind_child_left, kdeb
+C
+C
+      coeffraf = nint ( ds_parent(1) / ds_child(1) )
+      IF((TypeInterp(1) == Agrif_Linear) .AND. (coeffraf/=1))THEN 
+        Call linear1Dprecompute2D(
+     &          indmax(2)-indmin(2)+1,
+     &          indmax(1)-indmin(1)+1,
+     &          petab_child(1)-pttab_child(1)+1,
+     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+      precomputedone(1) = .TRUE. 
+      ELSEIF((TypeInterp(1) == Agrif_PPM) .AND. (coeffraf/=1))THEN
+        Call ppm1Dprecompute2D(
+     &          indmax(2)-indmin(2)+1,
+     &          indmax(1)-indmin(1)+1,
+     &          petab_child(1)-pttab_child(1)+1,
+     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+      precomputedone(1) = .TRUE.
+      ENDIF
+
+      coeffraf = nint ( ds_parent(2) / ds_child(2) )
+      IF((TypeInterp(2) == Agrif_Linear) .AND. (coeffraf/=1)) THEN
+         Call linear1Dprecompute2D(
+     &          petab_child(1)-pttab_child(1)+1,
+     &          indmax(2)-indmin(2)+1,
+     &          petab_child(2)-pttab_child(2)+1,
+     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+      precomputedone(2) = .TRUE. 
+      ELSEIF((TypeInterp(2) == Agrif_PPM) .AND. (coeffraf/=1)) THEN
+         Call ppm1Dprecompute2D(
+     &          petab_child(1)-pttab_child(1)+1,
+     &          indmax(2)-indmin(2)+1,
+     &          petab_child(2)-pttab_child(2)+1,
+     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+      precomputedone(2) = .TRUE.
+      ENDIF
+
+      do k = indmin(nbdim),indmax(nbdim)
+C        
+        Call Agrif_Interp_2D_recursive(TypeInterp(1:2),
+     &         tabin(indmin(nbdim-2):indmax(nbdim-2),
+     &         indmin(nbdim-1):indmax(nbdim-1),k),
+     &         tabtemp(pttab_child(nbdim-2):petab_child(nbdim-2),
+     &         pttab_child(nbdim-1):petab_child(nbdim-1),k),
+     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
+     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
+     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
+     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
+C        
+      enddo
+      
+      precomputedone(1) = .FALSE.
+      precomputedone(2) = .FALSE.
+      coeffraf = nint ( ds_parent(3) / ds_child(3) )
+
+      Call Agrif_Compute_nbdim_interp(s_parent(nbdim),s_child(nbdim),
+     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
+           
+      IF (coeffraf == 1) THEN
+      
+      kdeb = indmin(3)+locind_child_left-2
+      do k=pttab_child(3),petab_child(3)
+      kdeb = kdeb + 1
+      do j = pttab_child(2),petab_child(2)
+        do i = pttab_child(1),petab_child(1)
+        tabout(i,j,k) = tabtemp(i,j,kdeb)
+      enddo
+      enddo
+      enddo
+              
+      ELSE      
+C
+      do j=pttab_child(nbdim-1),petab_child(nbdim-1) 
+C        
+        do i=pttab_child(nbdim-2),petab_child(nbdim-2)
+C
+          Call Agrif_InterpBase(TypeInterp(3),
+     &           tabtemp(i,j,indmin(nbdim):indmax(nbdim)),
+     &           tabout(i,j,pttab_child(nbdim):petab_child(nbdim)),
+     &           indmin(nbdim),indmax(nbdim),
+     &           pttab_child(nbdim),petab_child(nbdim),
+     &           s_parent(nbdim),s_child(nbdim),
+     &           ds_parent(nbdim),ds_child(nbdim),coeffraf)
+C
+        enddo 
+C       
+      enddo
+      ENDIF
+C
+      Return
+C        
+C
+      End Subroutine Agrif_Interp_3D_recursive
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_4D_Recursive 
+C     **************************************************************************
+C
+      Subroutine Agrif_Interp_4D_recursive(TypeInterp,tabin,tabout,
+     &           indmin,indmax,   
+     &           pttab_child,petab_child,
+     &           s_child,s_parent,ds_child,ds_parent,nbdim)
+C
+CCC   Description:
+CCC   Subroutine for the interpolation of a 4D grid variable. 
+CCC   It calls Agrif_Interp_3D_recursive and Agrif_InterpBase.    
+C
+C     Declarations:
+C
+      
+C     
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(4) :: TypeInterp
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL, DIMENSION(nbdim) :: s_child,s_parent,ds_child,ds_parent
+      REAL,INTENT(IN), DIMENSION(indmin(nbdim-3):indmax(nbdim-3),
+     &                indmin(nbdim-2):indmax(nbdim-2),
+     &                indmin(nbdim-1):indmax(nbdim-1),
+     &                indmin(nbdim):indmax(nbdim)) :: tabin        
+      REAL,INTENT(OUT),
+     &       DIMENSION(pttab_child(nbdim-3):petab_child(nbdim-3),
+     &                pttab_child(nbdim-2):petab_child(nbdim-2),
+     &                pttab_child(nbdim-1):petab_child(nbdim-1),
+     &                pttab_child(nbdim):petab_child(nbdim)) :: tabout
+C
+C     Local variables      
+      REAL, DIMENSION(pttab_child(nbdim-3):petab_child(nbdim-3),
+     &                 pttab_child(nbdim-2):petab_child(nbdim-2),
+     &                 pttab_child(nbdim-1):petab_child(nbdim-1),  
+     &                 indmin(nbdim):indmax(nbdim)) :: tabtemp
+      INTEGER i,j,k,l
+      INTEGER :: coeffraf
+C
+C
+      do l = indmin(nbdim),indmax(nbdim)
+C        
+        Call Agrif_Interp_3D_recursive(TypeInterp(1:3),
+     &         tabin(indmin(nbdim-3):indmax(nbdim-3),
+     &               indmin(nbdim-2):indmax(nbdim-2),
+     &               indmin(nbdim-1):indmax(nbdim-1),l),
+     &         tabtemp(pttab_child(nbdim-3):petab_child(nbdim-3),
+     &         pttab_child(nbdim-2):petab_child(nbdim-2),
+     &         pttab_child(nbdim-1):petab_child(nbdim-1),l),
+     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
+     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
+     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
+     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
+C        
+      enddo
+C
+      coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
+      
+      do k = pttab_child(nbdim-1),petab_child(nbdim-1)
+C
+        do j = pttab_child(nbdim-2),petab_child(nbdim-2) 
+C        
+          do i = pttab_child(nbdim-3),petab_child(nbdim-3)
+C
+            Call Agrif_InterpBase(TypeInterp(4),
+     &           tabtemp(i,j,k,indmin(nbdim):indmax(nbdim)),
+     &           tabout(i,j,k,pttab_child(nbdim):petab_child(nbdim)),
+     &           indmin(nbdim),indmax(nbdim),
+     &           pttab_child(nbdim),petab_child(nbdim),
+     &           s_parent(nbdim),s_child(nbdim),
+     &           ds_parent(nbdim),ds_child(nbdim),coeffraf)
+C
+          enddo
+C
+        enddo 
+C       
+      enddo
+C
+      Return
+C
+C        
+      End Subroutine Agrif_Interp_4D_recursive
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_5D_Recursive 
+C     **************************************************************************
+C
+      Subroutine Agrif_Interp_5D_recursive(TypeInterp,tabin,tabout,
+     &           indmin,indmax,   
+     &           pttab_child,petab_child,
+     &           s_child,s_parent,ds_child,ds_parent,nbdim)
+C
+CCC   Description:
+CCC   Subroutine for the interpolation of a 5D grid variable. 
+CCC   It calls Agrif_Interp_4D_recursive and Agrif_InterpBase.    
+C
+C     Declarations:
+C
+      
+C     
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(5) :: TypeInterp
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL, DIMENSION(nbdim) :: s_child,s_parent,ds_child,ds_parent
+      REAL,INTENT(IN), DIMENSION(indmin(nbdim-4):indmax(nbdim-4),
+     &                indmin(nbdim-3):indmax(nbdim-3),
+     &                indmin(nbdim-2):indmax(nbdim-2),
+     &                indmin(nbdim-1):indmax(nbdim-1),
+     &                indmin(nbdim):indmax(nbdim)) :: tabin  
+      REAL,INTENT(OUT),
+     &    DIMENSION(pttab_child(nbdim-4):petab_child(nbdim-4),
+     &                pttab_child(nbdim-3):petab_child(nbdim-3),
+     &                pttab_child(nbdim-2):petab_child(nbdim-2),
+     &                pttab_child(nbdim-1):petab_child(nbdim-1),
+     &                pttab_child(nbdim):petab_child(nbdim)) :: tabout
+C
+C     Local variables      
+      REAL, DIMENSION(pttab_child(nbdim-4):petab_child(nbdim-4),
+     &                 pttab_child(nbdim-3):petab_child(nbdim-3),
+     &                 pttab_child(nbdim-2):petab_child(nbdim-2),
+     &                 pttab_child(nbdim-1):petab_child(nbdim-1),    
+     &                 indmin(nbdim):indmax(nbdim)) :: tabtemp
+      INTEGER i,j,k,l,m
+      INTEGER :: coeffraf
+C
+C
+      do m = indmin(nbdim),indmax(nbdim)
+C        
+        Call Agrif_Interp_4D_recursive(TypeInterp(1:4),
+     &         tabin(indmin(nbdim-4):indmax(nbdim-4),
+     &               indmin(nbdim-3):indmax(nbdim-3),
+     &               indmin(nbdim-2):indmax(nbdim-2),
+     &               indmin(nbdim-1):indmax(nbdim-1),m),
+     &         tabtemp(pttab_child(nbdim-4):petab_child(nbdim-4),
+     &                 pttab_child(nbdim-3):petab_child(nbdim-3),
+     &                 pttab_child(nbdim-2):petab_child(nbdim-2),
+     &                 pttab_child(nbdim-1):petab_child(nbdim-1),m),
+     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
+     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
+     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
+     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
+C        
+      enddo
+      
+      coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
+C
+      do l = pttab_child(nbdim-1),petab_child(nbdim-1) 
+C
+        do k = pttab_child(nbdim-2),petab_child(nbdim-2)
+C
+          do j = pttab_child(nbdim-3),petab_child(nbdim-3) 
+C        
+            do i = pttab_child(nbdim-4),petab_child(nbdim-4)
+C
+              Call Agrif_InterpBase(TypeInterp(5),
+     &             tabtemp(i,j,k,l,indmin(nbdim):indmax(nbdim)),
+     &                    tabout(i,j,k,l,
+     &             pttab_child(nbdim):petab_child(nbdim)),
+     &             indmin(nbdim),indmax(nbdim),
+     &             pttab_child(nbdim),petab_child(nbdim),
+     &             s_parent(nbdim),s_child(nbdim),
+     &             ds_parent(nbdim),ds_child(nbdim),coeffraf)
+C
+            enddo
+C
+          enddo
+C
+        enddo 
+C       
+      enddo
+C
+C
+      Return
+C
+C        
+      End Subroutine Agrif_Interp_5D_recursive
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_6D_Recursive 
+C     **************************************************************************
+C
+      Subroutine Agrif_Interp_6D_recursive(TypeInterp,tabin,tabout,
+     &           indmin,indmax,   
+     &           pttab_child,petab_child,
+     &           s_child,s_parent,ds_child,ds_parent,nbdim)
+C
+CCC   Description:
+CCC   Subroutine for the interpolation of a 6D grid variable. 
+CCC   It calls Agrif_Interp_4D_recursive and Agrif_InterpBase.    
+C
+C     Declarations:
+C
+      
+C     
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(6) :: TypeInterp
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL, DIMENSION(nbdim) :: s_child,s_parent,ds_child,ds_parent
+      REAL,INTENT(IN), DIMENSION(indmin(nbdim-5):indmax(nbdim-5),
+     &                indmin(nbdim-4):indmax(nbdim-4),
+     &                indmin(nbdim-3):indmax(nbdim-3), 
+     &                indmin(nbdim-2):indmax(nbdim-2),
+     &                indmin(nbdim-1):indmax(nbdim-1),
+     &                indmin(nbdim):indmax(nbdim)) :: tabin        
+      REAL,INTENT(OUT),
+     &    DIMENSION(pttab_child(nbdim-5):petab_child(nbdim-5),
+     &                pttab_child(nbdim-4):petab_child(nbdim-4),
+     &                pttab_child(nbdim-3):petab_child(nbdim-3),
+     &                pttab_child(nbdim-2):petab_child(nbdim-2),
+     &                pttab_child(nbdim-1):petab_child(nbdim-1),
+     &                pttab_child(nbdim):petab_child(nbdim)) :: tabout
+C
+C     Local variables      
+      REAL, DIMENSION(pttab_child(nbdim-5):petab_child(nbdim-5),
+     &                 pttab_child(nbdim-4):petab_child(nbdim-4),
+     &                 pttab_child(nbdim-3):petab_child(nbdim-3),
+     &                 pttab_child(nbdim-2):petab_child(nbdim-2),    
+     &                 pttab_child(nbdim-1):petab_child(nbdim-1),    
+     &                 indmin(nbdim):indmax(nbdim)) :: tabtemp
+      INTEGER i,j,k,l,m,n
+      INTEGER :: coeffraf
+C
+C        
+C
+      do n = indmin(nbdim),indmax(nbdim)
+C        
+        Call Agrif_Interp_5D_recursive(TypeInterp(1:5),
+     &         tabin(indmin(nbdim-5):indmax(nbdim-5),
+     &               indmin(nbdim-4):indmax(nbdim-4),
+     &               indmin(nbdim-3):indmax(nbdim-3),
+     &               indmin(nbdim-2):indmax(nbdim-2),
+     &               indmin(nbdim-1):indmax(nbdim-1),n),
+     &         tabtemp(pttab_child(nbdim-5):petab_child(nbdim-5),
+     &                 pttab_child(nbdim-4):petab_child(nbdim-4),
+     &                 pttab_child(nbdim-3):petab_child(nbdim-3),
+     &                 pttab_child(nbdim-2):petab_child(nbdim-2),
+     &                 pttab_child(nbdim-1):petab_child(nbdim-1),n),
+     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
+     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
+     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
+     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
+C        
+      enddo
+      
+      coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
+C
+      do m = pttab_child(nbdim-1),petab_child(nbdim-1) 
+      do l = pttab_child(nbdim-2),petab_child(nbdim-2) 
+C
+        do k = pttab_child(nbdim-3),petab_child(nbdim-3)
+C
+          do j = pttab_child(nbdim-4),petab_child(nbdim-4) 
+C        
+            do i = pttab_child(nbdim-5),petab_child(nbdim-5)
+C
+              Call Agrif_InterpBase(TypeInterp(6),
+     &             tabtemp(i,j,k,l,m,indmin(nbdim):indmax(nbdim)),
+     &                    tabout(i,j,k,l,m,
+     &                    pttab_child(nbdim):petab_child(nbdim)),
+     &             indmin(nbdim),indmax(nbdim),
+     &             pttab_child(nbdim),petab_child(nbdim),
+     &             s_parent(nbdim),s_child(nbdim),
+     &             ds_parent(nbdim),ds_child(nbdim),coeffraf)
+C
+            enddo
+C
+          enddo
+C
+        enddo 
+C       
+      enddo
+      enddo
+C                
+C
+      Return
+C
+C        
+      End Subroutine Agrif_Interp_6D_recursive
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_InterpBase  
+C     **************************************************************************
+C  
+      Subroutine Agrif_InterpBase(TypeInterp,
+     &                           parenttab,childtab,
+     &                           indmin,indmax,pttab_child,petab_child,
+     &                           s_parent,s_child,ds_parent,ds_child,
+     &                           coeffraf)   
+C
+CCC   Description:
+CCC   Subroutine calling the interpolation method chosen by the user (linear, 
+CCC   lagrange or spline). 
+C
+C     Declarations:
+C
+      
+C
+      INTEGER                :: TypeInterp
+      INTEGER :: indmin,indmax
+      INTEGER :: pttab_child,petab_child
+      REAL,INTENT(IN),DIMENSION(indmin:indmax)           :: parenttab       
+      REAL,INTENT(OUT),DIMENSION(pttab_child:petab_child) :: childtab        
+      REAL    :: s_parent,s_child,ds_parent,ds_child 
+      INTEGER :: coeffraf
+C 
+C
+       IF ((indmin == indmax).AND.(pttab_child == petab_child)) THEN
+         childtab(pttab_child) = parenttab(indmin)
+       ELSEIF (TYPEinterp .EQ. AGRIF_LINEAR) then    
+C
+C         Linear interpolation 
+  
+          Call linear1D
+     &         (parenttab,childtab,
+     &          indmax-indmin+1,petab_child-pttab_child+1,
+     &          s_parent,s_child,ds_parent,ds_child)
+C          
+      elseif ( TYPEinterp .EQ. AGRIF_PPM ) then
+
+          Call ppm1D
+     &         (parenttab,childtab,
+     &         indmax-indmin+1,petab_child-pttab_child+1,
+     &         s_parent,s_child,ds_parent,ds_child)
+C
+
+        elseif (TYPEinterp .EQ. AGRIF_LAGRANGE) then
+C          
+C         Lagrange interpolation    
+          Call lagrange1D
+     &        (parenttab,childtab,
+     &         indmax-indmin+1,petab_child-pttab_child+1,
+     &         s_parent,s_child,ds_parent,ds_child)
+C            
+        elseif (TYPEinterp .EQ. AGRIF_ENO) then
+C          
+C         Eno interpolation
+          Call eno1D
+     &         (parenttab,childtab,
+     &         indmax-indmin+1,petab_child-pttab_child+1,
+     &         s_parent,s_child,ds_parent,ds_child)
+C        
+        elseif (TYPEinterp .EQ. AGRIF_WENO) then
+C          
+C         Eno interpolation
+          Call weno1D
+     &         (parenttab,childtab,
+     &         indmax-indmin+1,petab_child-pttab_child+1,
+     &         s_parent,s_child,ds_parent,ds_child)
+C            
+        Else if (TYPEinterp .EQ. AGRIF_LINEARCONSERV) then
+C          
+C         Linear conservative interpolation
+          
+          Call linear1Dconserv
+     &         (parenttab,childtab,
+     &         indmax-indmin+1,petab_child-pttab_child+1,
+     &         s_parent,s_child,ds_parent,ds_child)   
+C              
+        Else if (TYPEinterp .EQ. AGRIF_LINEARCONSERVLIM) then
+C          
+C         Linear conservative interpolation
+          
+          Call linear1Dconservlim
+     &         (parenttab,childtab,
+     &         indmax-indmin+1,petab_child-pttab_child+1,
+     &         s_parent,s_child,ds_parent,ds_child)         
+C              
+        elseif (TYPEinterp .EQ. AGRIF_CONSTANT) then
+C          
+          Call constant1D
+     &         (parenttab,childtab,
+     &         indmax-indmin+1,petab_child-pttab_child+1,
+     &         s_parent,s_child,ds_parent,ds_child)
+C              
+      endif 
+C
+C      
+      End Subroutine Agrif_InterpBase 
+C
+
+      Subroutine Agrif_Compute_nbdim_interp(s_parent,s_child,
+     &  ds_parent,ds_child,coeffraf,locind_child_left)
+      real :: s_parent,s_child,ds_parent,ds_child
+      integer :: coeffraf,locind_child_left
+     
+      coeffraf = nint(ds_parent/ds_child)
+      locind_child_left = 1 + agrif_int((s_child-s_parent)/ds_parent)
+      End Subroutine Agrif_Compute_nbdim_interp
+C          
+
+      Subroutine Agrif_Find_list_interp(list_interp,pttab,petab,
+     &                          pttab_Child,pttab_Parent,nbdim,
+     &                          indmin,indmax,indminglob,
+     &      indmaxglob,indminglob2,indmaxglob2,parentarray,
+     &       pttruetab,cetruetab,member,memberin,
+     &      find_list_interp
+#if defined key_mpp_mpi
+     &     ,tab4t,memberinall,sendtoproc1,recvfromproc1
+#endif
+     &    )     
+      TYPE(Agrif_List_Interp_Loc), Pointer :: list_interp
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim)   :: pttab,petab,pttab_Child,pttab_Parent
+      LOGICAL :: find_list_interp
+      Type(Agrif_List_Interp_loc), Pointer :: parcours
+      INTEGER,DIMENSION(nbdim)   :: indmin,indmax  
+      INTEGER,DIMENSION(nbdim)   :: indminglob,indmaxglob
+      INTEGER,DIMENSION(nbdim)   :: pttruetab,cetruetab      
+      INTEGER,DIMENSION(nbdim)   :: indminglob2,indmaxglob2  
+      INTEGER,DIMENSION(nbdim,2,2) :: parentarray
+      LOGICAL :: member, memberin
+      INTEGER :: i
+#ifdef key_mpp_mpi
+C
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
+      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall
+      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1
+#endif 
+                    
+      find_list_interp = .FALSE.
+      
+      parcours => list_interp
+      Find_loop :   Do While (associated(parcours))
+        Do i=1,nbdim
+          IF ((pttab(i) /= parcours%interp_loc%pttab(i)).OR.
+     &        (petab(i) /= parcours%interp_loc%petab(i)).OR.
+     &        (pttab_child(i) /= parcours%interp_loc%pttab_child(i)).OR.
+     &        (pttab_parent(i) /= parcours%interp_loc%pttab_parent(i)))
+     &               THEN
+            parcours=>parcours%suiv
+            Cycle Find_loop
+          ENDIF
+        EndDo
+
+        indmin = parcours%interp_loc%indmin(1:nbdim)
+        indmax = parcours%interp_loc%indmax(1:nbdim)
+        
+        pttruetab = parcours%interp_loc%pttruetab(1:nbdim)
+        cetruetab = parcours%interp_loc%cetruetab(1:nbdim)
+                
+#if !defined key_mpp_mpi
+        indminglob = parcours%interp_loc%indminglob(1:nbdim)
+        indmaxglob = parcours%interp_loc%indmaxglob(1:nbdim)
+#else
+        indminglob2 = parcours%interp_loc%indminglob2(1:nbdim)
+        indmaxglob2 = parcours%interp_loc%indmaxglob2(1:nbdim)
+        parentarray = parcours%interp_loc%parentarray(1:nbdim,:,:)
+        member = parcours%interp_loc%member
+        tab4t = parcours%interp_loc%tab4t(1:nbdim,0:Agrif_Nbprocs-1,1:8)
+        memberinall = parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1)
+        sendtoproc1 = parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1)
+        recvfromproc1 = 
+     &    parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1)
+#endif        
+        memberin = parcours%interp_loc%memberin
+        find_list_interp = .TRUE.   
+        Exit Find_loop
+      End Do Find_loop  
+                              
+      End Subroutine Agrif_Find_list_interp   
+      
+      Subroutine Agrif_AddTo_list_interp(list_interp,pttab,petab,
+     &                          pttab_Child,pttab_Parent,indmin,indmax,
+     &                          indminglob,indmaxglob,
+     &                          indminglob2,indmaxglob2,
+     &                          parentarray,pttruetab,cetruetab,
+     &                          member,memberin,nbdim
+#if defined key_mpp_mpi
+     &      ,tab4t,memberinall,sendtoproc1,recvfromproc1
+#endif
+     &    )
+          
+      TYPE(Agrif_List_Interp_Loc), Pointer :: list_interp
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim)   :: pttab,petab,pttab_Child,pttab_Parent
+      INTEGER,DIMENSION(nbdim)   :: indmin,indmax
+      INTEGER,DIMENSION(nbdim)   :: indminglob,indmaxglob
+      INTEGER,DIMENSION(nbdim)   :: indminglob2,indmaxglob2
+      INTEGER,DIMENSION(nbdim)   :: pttruetab,cetruetab
+      INTEGER,DIMENSION(nbdim,2,2) :: parentarray
+      LOGICAL :: member, memberin
+#ifdef key_mpp_mpi
+C
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: memberinall
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: recvfromproc1
+#endif                   
+      Type(Agrif_List_Interp_loc), Pointer :: parcours
+            
+       Allocate(parcours)
+      Allocate(parcours%interp_loc)
+      
+      parcours%interp_loc%pttab(1:nbdim) = pttab(1:nbdim)
+      parcours%interp_loc%petab(1:nbdim) = petab(1:nbdim)
+      parcours%interp_loc%pttab_child(1:nbdim) = pttab_child(1:nbdim)
+      parcours%interp_loc%pttab_parent(1:nbdim) = pttab_parent(1:nbdim)
+  
+  
+      parcours%interp_loc%indmin(1:nbdim) = indmin(1:nbdim)
+      parcours%interp_loc%indmax(1:nbdim) = indmax(1:nbdim)
+
+      parcours%interp_loc%memberin = memberin
+#if !defined key_mpp_mpi
+      parcours%interp_loc%indminglob(1:nbdim) = indminglob(1:nbdim)
+      parcours%interp_loc%indmaxglob(1:nbdim) = indmaxglob(1:nbdim)
+#else
+      parcours%interp_loc%indminglob2(1:nbdim) = indminglob2(1:nbdim)
+      parcours%interp_loc%indmaxglob2(1:nbdim) = indmaxglob2(1:nbdim)
+      parcours%interp_loc%parentarray(1:nbdim,:,:) 
+     &       = parentarray(1:nbdim,:,:)
+      parcours%interp_loc%member = member
+      Allocate(parcours%interp_loc%tab4t(nbdim,0:Agrif_Nbprocs-1,8))
+      Allocate(parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1))
+      Allocate(parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1))
+      Allocate(parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1))                  
+      parcours%interp_loc%tab4t=tab4t   
+      parcours%interp_loc%memberinall=memberinall   
+      parcours%interp_loc%sendtoproc1=sendtoproc1
+      parcours%interp_loc%recvfromproc1=recvfromproc1            
+#endif      
+
+      parcours%interp_loc%pttruetab(1:nbdim) = pttruetab(1:nbdim)
+      parcours%interp_loc%cetruetab(1:nbdim) = cetruetab(1:nbdim)
+      
+      parcours%suiv => list_interp
+      
+      list_interp => parcours
+      End Subroutine Agrif_Addto_list_interp 
+                
+      End Module Agrif_Interpolation
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterpbasic.F
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterpbasic.F	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterpbasic.F	(revision 8201)
@@ -0,0 +1,1706 @@
+!
+! $Id: modinterpbasic.F 2715 2011-03-30 15:58:35Z rblod $
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_Interpbasic
+C
+      Module Agrif_Interpbasic
+C
+CCC   Description:
+CCC   Module containing different procedures of interpolation (linear,lagrange,
+CCC   spline,...) used in the Agrif_Interpolation module.
+C
+C     Modules used:
+      USE Agrif_types
+C
+      IMPLICIT NONE
+C             
+      Real,Dimension(Agrif_MaxRaff) :: tabdiff2, tabdiff3
+      Real,Dimension(5,Agrif_MaxRaff,3) :: tabppm
+      Real,Dimension(:),Allocatable::tabtest4   
+      Integer, Dimension(:,:), Allocatable :: indparent
+      Integer, Dimension(:,:), Allocatable :: 
+     &           indparentppm,indchildppm
+      Integer, Dimension(:), Allocatable :: 
+     &           indparentppm_1d,indchildppm_1d
+      Real, Dimension(:,:),Allocatable :: coeffparent   
+       
+      CONTAINS
+C     Define procedures contained in this module
+C  
+C     **************************************************************************  
+CCC   Subroutine Linear1d  
+C     ************************************************************************** 
+C 
+      Subroutine Linear1d(x,y,np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to do a linear 1D interpolation on a child grid (vector y) from
+CCC   its parent grid (vector x).  
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C        
+C     Arguments
+      INTEGER             :: np,nc      
+      REAL,INTENT(IN), DIMENSION(np) :: x      
+      REAL,INTENT(OUT), DIMENSION(nc) :: y  
+      REAL                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      INTEGER :: i,coeffraf,locind_parent_left
+      REAL    :: ypos,globind_parent_left,globind_parent_right
+      REAL    :: invds, invds2
+      REAL :: ypos2,diff
+C
+C
+
+      coeffraf = nint(ds_parent/ds_child)
+C
+      if (coeffraf == 1) then
+C
+          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+C        
+          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+C
+          return
+C
+      endif                          
+C
+      ypos = s_child 
+
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+
+        globind_parent_left = s_parent 
+     &                        + (locind_parent_left - 1)*ds_parent
+
+        globind_parent_right = globind_parent_left + ds_parent
+
+C
+      invds = 1./ds_parent
+      invds2 = ds_child/ds_parent
+      
+      ypos2 = ypos*invds
+      globind_parent_right=globind_parent_right*invds
+      
+      do i = 1,nc-1
+C
+        if (ypos2 > globind_parent_right) then
+           locind_parent_left = locind_parent_left + 1.
+           globind_parent_right = globind_parent_right + 1.
+           ypos2 = ypos*invds+(i-1)*invds2           
+        endif
+        
+        diff=(globind_parent_right - ypos2)
+        y(i) = (diff*x(locind_parent_left)
+     &        + (1.-diff)*x(locind_parent_left+1))
+C
+        ypos2 = ypos2 + invds2
+C
+      enddo
+C
+      ypos = s_child + (nc-1)*ds_child
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+C
+      if (locind_parent_left == np) then
+C
+          y(nc) = x(np)
+C
+        else
+C
+          globind_parent_left = s_parent 
+     &                        + (locind_parent_left - 1)*ds_parent  
+C      
+          y(nc) = ((globind_parent_left + ds_parent - ypos)
+     &            *x(locind_parent_left)
+     &          + (ypos - globind_parent_left)
+     &            *x(locind_parent_left+1))*invds
+C
+      endif                                          
+C           
+      Return
+C
+C       
+      End Subroutine Linear1d   
+      
+      Subroutine Linear1dprecompute2d(np2, np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child,dir)
+C
+CCC   Description:
+CCC   Subroutine to compute 2D coefficient and index for a linear 1D interpolation
+CCC   on a child grid (vector y) from its parent grid (vector x).
+C
+CC    Method:
+C
+C     Declarations:
+C
+
+C        
+C     Arguments
+      INTEGER             :: np,nc,np2,dir
+      REAL                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      INTEGER :: i,j,coeffraf,locind_parent_left,inc,inc1,inc2,toto 
+      Integer, Dimension(:,:), Allocatable :: indparent_tmp
+      Real, Dimension(:,:), Allocatable :: coeffparent_tmp
+      REAL    :: ypos,globind_parent_left,globind_parent_right
+      REAL    :: invds, invds2, invds3
+      REAL :: ypos2,diff
+C
+C
+
+      coeffraf = nint(ds_parent/ds_child)
+C
+      ypos = s_child
+
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+
+        globind_parent_left = s_parent
+     &                        + (locind_parent_left - 1)*ds_parent
+
+        globind_parent_right = globind_parent_left + ds_parent
+
+C
+      invds = 1./ds_parent
+      invds2 = ds_child/ds_parent
+      invds3 = 0.5/real(coeffraf)
+
+      ypos2 = ypos*invds
+      globind_parent_right=globind_parent_right*invds
+
+      if (.not.allocated(indparent)) then
+      allocate(indparent(nc*np2,3),coeffparent(nc*np2,3))
+      else
+      if (size(indparent,1)<nc*np2) then
+      allocate(coeffparent_tmp(size(indparent,1),size(indparent,2)))
+      allocate(indparent_tmp(size(indparent,1),size(indparent,2)))
+      coeffparent_tmp=coeffparent 
+      indparent_tmp=indparent 
+      deallocate(indparent,coeffparent)
+      allocate(indparent(nc*np2,3),coeffparent(nc*np2,3))
+      coeffparent(1:size(coeffparent_tmp,1),1:size(coeffparent_tmp,2))
+     &  = coeffparent_tmp 
+      indparent(1:size(indparent_tmp,1),1:size(indparent_tmp,2))
+     & = indparent_tmp
+      deallocate(indparent_tmp,coeffparent_tmp)
+      endif
+      endif
+
+      do i = 1,nc-1
+C
+        if (ypos2 > globind_parent_right) then
+           locind_parent_left = locind_parent_left + 1
+           globind_parent_right = globind_parent_right + 1.
+           ypos2 = ypos*invds+(i-1)*invds2
+        endif
+
+        diff=(globind_parent_right - ypos2)
+        diff = invds3*nint(2*coeffraf*diff)
+        indparent(i,dir) = locind_parent_left
+
+        coeffparent(i,dir) = diff
+        
+        ypos2 = ypos2 + invds2
+C
+      enddo
+C
+      ypos = s_child + (nc-1)*ds_child
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+
+      if (locind_parent_left == np) then
+      indparent(nc,dir) = locind_parent_left-1
+      coeffparent(nc,dir) = 0.
+        else
+C
+          globind_parent_left = s_parent
+     &                        + (locind_parent_left - 1)*ds_parent
+C      
+       indparent(nc,dir) = locind_parent_left
+       diff = (globind_parent_left + ds_parent - ypos)
+     &       * invds
+        diff = invds3*nint(2*coeffraf*diff)
+         coeffparent(nc,dir) = diff
+      endif                                           
+
+      do i=2, np2
+      inc  =  i*nc
+      inc1 = (i-1)*nc
+      inc2 = (i-2)*nc 
+!CDIR ALTCODE
+      indparent(1+inc1:inc,dir) = indparent(1+inc2:inc1,dir)+np
+!CDIR ALTCODE
+      coeffparent(1+inc1:inc,dir) =coeffparent(1:nc,dir)
+      enddo      
+
+      Return
+C
+C       
+      End Subroutine Linear1dprecompute2d
+
+
+
+      Subroutine Linear1dprecompute(np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to compute 1D coefficient and index for a linear 1D interpolation
+CCC   on a child grid (vector y) from its parent grid (vector x).
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C        
+C     Arguments
+      INTEGER             :: np,nc 
+      REAL                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      INTEGER :: i,coeffraf,locind_parent_left
+      REAL    :: ypos,globind_parent_left,globind_parent_right
+      REAL    :: invds, invds2, invds3
+      REAL :: ypos2,diff
+C
+C
+
+      coeffraf = nint(ds_parent/ds_child)
+C
+      if (coeffraf == 1) then
+C
+          return
+C
+      endif                          
+C
+      ypos = s_child 
+
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+
+        globind_parent_left = s_parent 
+     &                        + (locind_parent_left - 1)*ds_parent
+
+        globind_parent_right = globind_parent_left + ds_parent
+
+C
+      invds = 1./ds_parent
+      invds2 = ds_child/ds_parent
+      invds3 = 0.5/real(coeffraf)      
+      
+      ypos2 = ypos*invds
+      globind_parent_right=globind_parent_right*invds
+      
+      if (.not.allocated(indparent)) then
+      allocate(indparent(nc,1),coeffparent(nc,1))
+      else
+      if (size(indparent)<nc) then
+      deallocate(indparent,coeffparent)
+      allocate(indparent(nc,1),coeffparent(nc,1))
+      endif
+      endif
+      
+      do i = 1,nc-1
+C
+        if (ypos2 > globind_parent_right) then
+           locind_parent_left = locind_parent_left + 1
+           globind_parent_right = globind_parent_right + 1.
+           ypos2 = ypos*invds+(i-1)*invds2           
+        endif
+        
+        diff=(globind_parent_right - ypos2)
+        
+        diff = invds3*nint(2*coeffraf*diff)
+                
+        indparent(i,1) = locind_parent_left
+
+        coeffparent(i,1) = diff
+        ypos2 = ypos2 + invds2
+C
+      enddo
+C
+      ypos = s_child + (nc-1)*ds_child
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+      
+      if (locind_parent_left == np) then
+      indparent(nc,1) = locind_parent_left-1
+      coeffparent(nc,1) = 0.
+        else
+C
+          globind_parent_left = s_parent 
+     &                        + (locind_parent_left - 1)*ds_parent  
+C      
+       indparent(nc,1) = locind_parent_left
+       
+       diff = (globind_parent_left + ds_parent - ypos)
+     &       * invds
+        diff = invds3*nint(2*coeffraf*diff)
+         coeffparent(nc,1) = diff
+      endif                                          
+C           
+      Return
+C
+C       
+      End Subroutine Linear1dprecompute 
+      
+      Subroutine Linear1daftercompute(x,y,np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child,dir) 
+C
+CCC   Description:
+CCC   Subroutine to do a linear 1D interpolation on a child grid (vector y) from
+CCC   its parent grid (vector x) using precomputed coefficient and index.  
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C        
+C     Arguments
+      INTEGER             :: np,nc,dir      
+      REAL,INTENT(IN), DIMENSION(np) :: x      
+      REAL,INTENT(OUT), DIMENSION(nc) :: y  
+      REAL                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      INTEGER :: i,coeffraf,locind_parent_left
+      REAL    :: ypos,globind_parent_left,globind_parent_right
+      REAL    :: invds, invds2
+      REAL :: ypos2,diff
+C
+C
+
+!CDIR ALTCODE
+!CDIR NODEP
+      do i = 1,nc
+C
+       y(i)=coeffparent(i,dir)*x(MAX(indparent(i,dir),1))+
+     &      (1.-coeffparent(i,dir))*x(indparent(i,dir)+1)
+C
+      enddo                                     
+C           
+      Return
+C
+C       
+      End Subroutine Linear1daftercompute            
+       
+C
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Lagrange1d  
+C     **************************************************************************
+C
+      Subroutine Lagrange1d(x,y,np,nc,
+     &                      s_parent,s_child,ds_parent,ds_child)
+C
+CCC   Description:
+CCC   Subroutine to do a lagrange 1D interpolation on a child grid (vector y) 
+CCC   from its parent grid (vector x).  
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C             
+C     Arguments
+      INTEGER             :: np,nc      
+      REAL,INTENT(IN), DIMENSION(np) :: x      
+      REAL,INTENT(OUT), DIMENSION(nc) :: y  
+      REAL                :: s_parent,s_child,ds_parent,ds_child 
+C
+C     Local scalars
+      INTEGER :: i,coeffraf,locind_parent_left
+      REAL    :: ypos,globind_parent_left
+      REAL    :: X1,X2,X3 
+      real :: deltax,invdsparent
+      real t1,t2,t3,t4,t5,t6,t7,t8
+C
+C 
+      if (np <= 2) then
+C      
+          Call Linear1D(x,y,np,nc,
+     &                  s_parent,s_child,ds_parent,ds_child)
+C         
+         Return
+C 
+      endif
+C
+      coeffraf = nint(ds_parent/ds_child)
+C
+      if (coeffraf == 1) then
+C
+          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+C        
+          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+C
+          return
+C
+      endif
+      
+      invdsparent=1./ds_parent
+C
+      ypos = s_child      
+C
+      do i = 1,nc
+C
+        locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+C
+
+        globind_parent_left = s_parent 
+     &                        + (locind_parent_left - 1)*ds_parent 
+     
+C        deltax = invdsparent*(ypos-globind_parent_left)
+        deltax = nint(coeffraf*deltax)/real(coeffraf)
+        
+        ypos = ypos + ds_child
+         if (abs(deltax).LE.0.0001) then
+           y(i)=x(locind_parent_left)
+           
+           cycle
+         endif
+C           
+C
+        t2 = deltax - 2.
+        t3 = deltax - 1.
+        t4 = deltax + 1.
+        
+        t5 = -(1./6.)*deltax*t2*t3
+        t6 = 0.5*t2*t3*t4
+        t7 = -0.5*deltax*t2*t4
+        t8 = (1./6.)*deltax*t3*t4
+        
+        y(i)=t5*x(locind_parent_left-1)+t6*x(locind_parent_left)
+     &  +t7*x(locind_parent_left+1)+t8*x(locind_parent_left+2)
+C
+C
+      enddo
+C
+      return
+C
+C       
+      End Subroutine Lagrange1d 
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Constant1d  
+C     ************************************************************************** 
+C 
+      Subroutine constant1d(x,y,np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to do a linear 1D interpolation on a child grid (vector y) from
+CCC   its parent grid (vector x).  
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C        
+C     Arguments
+      INTEGER             :: np,nc      
+      REAL,INTENT(IN), DIMENSION(np) :: x      
+      REAL,INTENT(OUT), DIMENSION(nc) :: y  
+      REAL                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      INTEGER :: i,coeffraf,locind_parent
+      REAL    :: ypos
+C
+C
+
+      coeffraf = nint(ds_parent/ds_child)
+C
+      if (coeffraf == 1) then
+C
+          locind_parent = 1 + nint((s_child - s_parent)/ds_parent)
+C        
+          y(1:nc) = x(locind_parent:locind_parent+nc-1)
+C
+          return
+C
+      endif                          
+C
+      ypos = s_child      
+C
+      do i = 1,nc
+C
+        locind_parent = 1 + nint((ypos - s_parent)/ds_parent)
+C
+        y(i) = x(locind_parent)
+C
+        ypos = ypos + ds_child
+C
+      enddo
+C           
+      Return
+C
+C       
+      End Subroutine constant1d   
+C
+C     **************************************************************************  
+CCC   Subroutine Linear1dconserv
+C     ************************************************************************** 
+C 
+      Subroutine Linear1dconserv(x,y,np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to do a linear 1D interpolation on a child grid (vector y) from
+CCC   its parent grid (vector x).  
+C
+CC    Method:
+C
+C     Declarations:
+C
+      Implicit none
+C        
+C     Arguments
+      Integer             :: np,nc      
+      Real, Dimension(np) :: x      
+      Real, Dimension(nc) :: y
+      Real, Dimension(:),Allocatable :: ytemp
+      Real                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+      Real    :: ypos
+      integer :: i1,i2,ii
+      real :: xpmin,xpmax,slope
+      INTEGER :: diffmod
+      REAL :: xdiffmod
+
+C
+C
+
+      coeffraf = nint(ds_parent/ds_child)
+C
+      If (coeffraf == 1) Then
+C
+          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+C        
+          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+C
+          return
+C
+      End If
+C              
+      diffmod = 0
+      IF (mod(coeffraf,2) == 0) diffmod = 1  
+
+      xdiffmod = real(diffmod)/2.
+                         
+      allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
+C
+      ypos = s_child  
+C      
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) 
+
+      locind_parent_last = 1 +
+     &  agrif_ceiling((ypos +(nc - 1) *ds_child - s_parent)/ds_parent)
+     
+      xpmin = s_parent + (locind_parent_left-1)*ds_parent 
+      xpmax = s_parent + (locind_parent_last-1)*ds_parent          
+      
+      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+      i2 = 1+agrif_int((xpmax-s_child)/ds_child)
+
+      i = i1
+      
+      if (locind_parent_left == 1) then
+        slope=
+     &   (x(locind_parent_left+1)-x(locind_parent_left))/(coeffraf)
+      else
+         slope=
+     &   (x(locind_parent_left+1)-x(locind_parent_left-1))/(2.*coeffraf)
+      endif
+      
+        do ii=i-coeffraf/2+diffmod,i+coeffraf/2
+          ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+        enddo 
+
+        locind_parent_left = locind_parent_left + 1
+                      
+      do i=i1 +  coeffraf, i2 - coeffraf,coeffraf
+        slope=
+     &   (x(locind_parent_left+1)-x(locind_parent_left-1))/(2.*coeffraf)
+        do ii=i-coeffraf/2+diffmod,i+coeffraf/2
+          ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+        enddo
+        locind_parent_left = locind_parent_left + 1
+      enddo
+      
+      i = i2
+      
+      if (locind_parent_left == np) then
+        slope=
+     &   (x(locind_parent_left)-x(locind_parent_left-1))/(coeffraf)
+      else
+         slope=
+     &   (x(locind_parent_left+1)-x(locind_parent_left-1))/(2.*coeffraf)
+      endif
+      
+        do ii=i-coeffraf/2+diffmod,nc
+          ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+        enddo      
+C
+      y(1:nc)=ytemp(1:nc)                                   
+C           
+      deallocate(ytemp)
+      Return
+C       
+      End Subroutine Linear1dconserv
+      
+C
+C     **************************************************************************  
+CCC   Subroutine Linear1dconservlim
+C     ************************************************************************** 
+C 
+      Subroutine Linear1dconservlim(x,y,np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to do a linear 1D interpolation on a child grid (vector y) from
+CCC   its parent grid (vector x).  
+C
+CC    Method:
+C
+C     Declarations:
+C
+      Implicit none
+C        
+C     Arguments
+      Integer             :: np,nc      
+      Real, Dimension(np) :: x      
+      Real, Dimension(nc) :: y
+      Real, Dimension(:),Allocatable :: ytemp
+      Real                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+      Real    :: ypos
+      integer :: i1,i2,ii
+      real :: xpmin,xpmax,slope
+      INTEGER :: diffmod
+      real :: xdiffmod
+C
+C
+
+      coeffraf = nint(ds_parent/ds_child)
+C
+      If (coeffraf == 1) Then
+C
+          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+C        
+          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+C
+          return
+C
+      End If
+C
+      IF (coeffraf .NE.3) THEN
+      print *,'LINEARCONSERVLIM not ready for refinement ratio = ',
+     &   coeffraf
+      stop
+      ENDIF   
+      
+      diffmod = 0
+      IF (mod(coeffraf,2) == 0) diffmod = 1        
+
+      xdiffmod = real(diffmod)/2.
+                         
+      allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
+C
+      ypos = s_child  
+C      
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) 
+
+      locind_parent_last = 1 +
+     &  agrif_ceiling((ypos +(nc - 1) *ds_child - s_parent)/ds_parent)
+     
+      xpmin = s_parent + (locind_parent_left-1)*ds_parent 
+      xpmax = s_parent + (locind_parent_last-1)*ds_parent          
+      
+      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+      i2 = 1+agrif_int((xpmax-s_child)/ds_child)
+
+      i = i1
+      
+      if (locind_parent_left == 1) then
+        slope=0.       
+      else
+        slope = vanleer(x(locind_parent_left-1:locind_parent_left+1))
+        slope = slope / coeffraf    
+      endif
+      
+        do ii=i-coeffraf/2+diffmod,i+coeffraf/2
+          ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+        enddo 
+
+        locind_parent_left = locind_parent_left + 1
+                      
+      do i=i1 +  coeffraf, i2 - coeffraf,coeffraf     
+        slope = vanleer(x(locind_parent_left-1:locind_parent_left+1))
+        slope = slope / coeffraf
+
+        do ii=i-coeffraf/2+diffmod,i+coeffraf/2
+          ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+        enddo
+        locind_parent_left = locind_parent_left + 1
+      enddo
+      
+      i = i2
+      
+      if (locind_parent_left == np) then
+        slope=0.     
+      else
+        slope = vanleer(x(locind_parent_left-1:locind_parent_left+1))
+        slope = slope / coeffraf      
+      endif
+      
+        do ii=i-coeffraf/2+diffmod,nc
+          ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+        enddo      
+C
+      y(1:nc)=ytemp(1:nc)                                   
+C           
+      deallocate(ytemp)
+      Return
+C       
+      End Subroutine Linear1dconservlim      
+C         
+
+C     **************************************************************************  
+CCC   Subroutine ppm1d
+C     ************************************************************************** 
+C 
+      Subroutine ppm1d(x,y,np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to do a 1D interpolation and apply monotonicity constraints
+CCC   using piecewise parabolic method  
+CCC   on a child grid (vector y) from its parent grid (vector x).
+CC    Method:
+C
+C     Declarations:
+C
+      Implicit none
+C        
+C     Arguments
+      Integer             :: np,nc      
+      Real, INTENT(IN),Dimension(np) :: x      
+      Real, INTENT(OUT),Dimension(nc) :: y
+C      Real, Dimension(:),Allocatable :: ytemp
+      Real                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+      Integer :: iparent,ipos,pos,nmin,nmax
+      Real    :: ypos
+      integer :: i1,jj
+      Real :: xpmin,a
+C      
+      Real :: xrmin,xrmax,am3,s2,s1  
+      Real, Dimension(np) :: xl,delta,a6,slope
+C      Real, Dimension(:),Allocatable  :: diff,diff2,diff3    
+      INTEGER :: diffmod
+      REAL :: invcoeffraf
+C      
+      coeffraf = nint(ds_parent/ds_child)
+C
+      If (coeffraf == 1) Then
+          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+          return
+      End If
+      invcoeffraf = ds_child/ds_parent
+C      
+
+      IF( .NOT. allocated(tabtest4) ) THEN    
+      Allocate(tabtest4(-2*coeffraf:nc+2*coeffraf))
+      ELSE
+         IF (size(tabtest4) .LT. nc+4*coeffraf+1)THEN
+         deallocate( tabtest4 )
+         Allocate(tabtest4(-2*coeffraf:nc+2*coeffraf))
+         ENDIF
+      ENDIF
+            
+      ypos = s_child  
+C
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) 
+      locind_parent_last = 1 +
+     &      agrif_ceiling((ypos +(nc - 1) 
+     &      *ds_child - s_parent)/ds_parent)  
+C
+      xpmin = s_parent + (locind_parent_left-1)*ds_parent       
+      i1 = 1+agrif_int((xpmin-s_child)/ds_child)        
+C     
+C
+      
+!CDIR NOVECTOR
+      Do i=1,coeffraf
+        tabdiff2(i)=(real(i)-0.5)*invcoeffraf
+      EndDo
+
+      a = invcoeffraf**2 
+      tabdiff3(1) = (1./3.)*a
+      a=2.*a
+!CDIR NOVECTOR
+      Do i=2,coeffraf
+        tabdiff3(i) = tabdiff3(i-1)+(real(i)-1)*a
+      EndDo
+C
+      if( locind_parent_last+2 <= np ) then
+           nmax = locind_parent_last+2    
+      else if( locind_parent_last+1 <= np ) then
+           nmax = locind_parent_last+1
+      else
+           nmax = locind_parent_last 
+      endif     
+C      
+      if(locind_parent_left-1 >= 1) then
+          nmin = locind_parent_left-1
+      else 
+          nmin = locind_parent_left
+      endif    
+C 
+C
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+      Do i = nmin,nmax
+         slope(i) = x(i) - x(i-1)
+      Enddo
+
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+      Do i = nmin+1,nmax-1
+         xl(i)= 0.5*(x(i-1)+x(i))
+     &      -0.08333333333333*(slope(i+1)-slope(i-1)) 
+      Enddo
+C
+C apply parabolic monotonicity
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+       Do i = locind_parent_left,locind_parent_last
+          delta(i) = xl(i+1) - xl(i)
+          a6(i) = 6.*x(i)-3.*(xl(i) +xl(i+1))
+C
+       End do   
+C
+        diffmod = 0
+       IF (mod(coeffraf,2) == 0) diffmod = 1
+C
+        ipos = i1
+C               
+        Do iparent = locind_parent_left,locind_parent_last       
+             pos=1
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+C
+               tabtest4(jj) = xl(iparent)   
+     &             + tabdiff2(pos) *  (delta(iparent)+a6(iparent))
+     &             - tabdiff3(pos) *  a6(iparent)
+               pos = pos+1 
+             End do 
+             ipos = ipos + coeffraf
+C
+        End do
+C
+C
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+        y(1:nc)=tabtest4(1:nc)
+        
+      Return
+      End Subroutine ppm1d
+      
+
+      Subroutine ppm1dprecompute2d(np2,np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child,dir)
+C
+CCC   Description:
+CCC   Subroutine to compute 2D coefficients and index for a 1D interpolation
+CCC   using piecewise parabolic method  
+CC    Method: 
+C
+C     Declarations:
+C
+      Implicit none
+C        
+C     Arguments
+      Integer             :: np2,np,nc,dir
+C      Real, Dimension(:),Allocatable :: ytemp
+      Real                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      Integer, Dimension(:,:), Allocatable :: indparent_tmp
+      Integer, Dimension(:,:), Allocatable :: indchild_tmp
+      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+      Integer :: iparent,ipos,pos,nmin,nmax
+      Real    :: ypos
+      integer :: i1,jj
+      Real :: xpmin,a
+C      
+      Real :: xrmin,xrmax,am3,s2,s1
+      Real, Dimension(np) :: xl,delta,a6,slope
+      INTEGER :: diffmod
+      REAL :: invcoeffraf
+C      
+      coeffraf = nint(ds_parent/ds_child)
+C
+      invcoeffraf = ds_child/ds_parent
+C 
+
+      if (.not.allocated(indparentppm)) then
+      allocate(
+     & indparentppm(np2*nc,3),
+     & indchildppm(np2*nc,3)
+     &        )
+      else
+      if (size(indparentppm,1)<np2*nc) then
+      allocate(
+     &  indparent_tmp(size(indparentppm,1),size(indparentppm,2)),
+     &  indchild_tmp(size(indparentppm,1),size(indparentppm,2)))
+      indparent_tmp = indparentppm 
+      indchild_tmp  = indchildppm 
+      deallocate(indparentppm,indchildppm)
+      allocate(
+     &indparentppm(np2*nc,3),
+     &indchildppm(np2*nc,3)
+     &        )
+      indparentppm(1:size(indparent_tmp,1),1:size(indparent_tmp,2))
+     & = indparent_tmp
+      indchildppm(1:size(indparent_tmp,1),1:size(indparent_tmp,2))
+     & = indchild_tmp
+      deallocate(indparent_tmp,indchild_tmp)
+      endif
+      endif
+
+      if (.not.allocated(indparentppm_1d)) then
+      allocate(indparentppm_1d(-2*coeffraf:nc+2*coeffraf),
+     &         indchildppm_1d(-2*coeffraf:nc+2*coeffraf))
+      else
+      if (size(indparentppm_1d)<nc+4*coeffraf+1) then
+      deallocate(indparentppm_1d,indchildppm_1d)
+      allocate(indparentppm_1d(-2*coeffraf:nc+2*coeffraf),
+     &         indchildppm_1d(-2*coeffraf:nc+2*coeffraf))
+      endif
+      endif
+
+
+      ypos = s_child
+C
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+      locind_parent_last = 1 +
+     &      agrif_ceiling((ypos +(nc - 1)
+     &      *ds_child - s_parent)/ds_parent)
+C
+      xpmin = s_parent + (locind_parent_left-1)*ds_parent
+      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+C     
+C
+
+      Do i=1,coeffraf
+        tabdiff2(i)=(real(i)-0.5)*invcoeffraf
+      EndDo
+
+      a = invcoeffraf**2
+      tabdiff3(1) = (1./3.)*a
+      a=2.*a
+!CDIR ALTCODE
+      Do i=2,coeffraf
+        tabdiff3(i) = tabdiff3(i-1)+(real(i)-1)*a
+      EndDo
+
+!CDIR ALTCODE
+      Do i=1,coeffraf
+      tabppm(1,i,dir) = 0.08333333333333*
+     &              (-1.+4*tabdiff2(i)-3*tabdiff3(i))
+      tabppm(2,i,dir) = 0.08333333333333*
+     &              (7.-26.*tabdiff2(i)+18.*tabdiff3(i))
+      tabppm(3,i,dir) = 0.08333333333333*
+     &              (7.+30*tabdiff2(i)-30*tabdiff3(i))
+      tabppm(4,i,dir) = 0.08333333333333*
+     &              (-1.-10.*tabdiff2(i)+18.*tabdiff3(i))
+      tabppm(5,i,dir) = 0.08333333333333*
+     &              (2*tabdiff2(i)-3*tabdiff3(i))                   
+      End Do
+C 
+C
+        diffmod = 0
+       IF (mod(coeffraf,2) == 0) diffmod = 1
+C
+        ipos = i1
+C               
+        Do iparent = locind_parent_left,locind_parent_last
+             pos=1
+!CDIR ALTCODE
+             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+         indparentppm_1d(jj) = iparent-2
+         indchildppm_1d(jj) = pos
+               pos = pos+1
+             End do
+             ipos = ipos + coeffraf
+C
+        End do
+     
+       Do i=1,np2
+
+       indparentppm(1+(i-1)*nc:i*nc,dir) = 
+     &             indparentppm_1d(1:nc) + (i-1)*np
+       indchildppm (1+(i-1)*nc:i*nc,dir) = 
+     &             indchildppm_1d (1:nc) 
+
+       End do
+
+      Return
+      End Subroutine ppm1dprecompute2d
+
+
+      Subroutine ppm1dprecompute(np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to compute coefficient and index for  a 1D interpolation 
+CCC   using piecewise parabolic method  
+CC    Method:
+C
+C     Declarations:
+C
+      Implicit none
+C        
+C     Arguments
+      Integer             :: np,nc
+C      Real, Dimension(:),Allocatable :: ytemp
+      Real                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+      Integer :: iparent,ipos,pos,nmin,nmax
+      Real    :: ypos
+      integer :: i1,jj
+      Real :: xpmin,a
+C      
+      Real :: xrmin,xrmax,am3,s2,s1  
+      Real, Dimension(np) :: xl,delta,a6,slope
+C      Real, Dimension(:),Allocatable  :: diff,diff2,diff3    
+      INTEGER :: diffmod
+      REAL :: invcoeffraf
+C      
+      coeffraf = nint(ds_parent/ds_child)
+C
+      If (coeffraf == 1) Then
+          return
+      End If
+      invcoeffraf = ds_child/ds_parent
+C 
+      
+      if (.not.allocated(indparentppm)) then
+      allocate(indparentppm(-2*coeffraf:nc+2*coeffraf,1),
+     &         indchildppm(-2*coeffraf:nc+2*coeffraf,1))
+      else
+      if (size(indparentppm,1)<nc+4*coeffraf+1) then
+      deallocate(indparentppm,indchildppm)
+      allocate(indparentppm(-2*coeffraf:nc+2*coeffraf,1),
+     &         indchildppm(-2*coeffraf:nc+2*coeffraf,1))
+      endif
+      endif
+            
+      ypos = s_child  
+C
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) 
+      locind_parent_last = 1 +
+     &      agrif_ceiling((ypos +(nc - 1) 
+     &      *ds_child - s_parent)/ds_parent)  
+C
+      xpmin = s_parent + (locind_parent_left-1)*ds_parent       
+      i1 = 1+agrif_int((xpmin-s_child)/ds_child)        
+C     
+C
+      
+      Do i=1,coeffraf
+        tabdiff2(i)=(real(i)-0.5)*invcoeffraf
+      EndDo
+
+      a = invcoeffraf**2 
+      tabdiff3(1) = (1./3.)*a
+      a=2.*a
+!CDIR ALTCODE
+!!!CDIR SHORTLOOP
+      Do i=2,coeffraf
+        tabdiff3(i) = tabdiff3(i-1)+(real(i)-1)*a
+      EndDo
+      
+!CDIR ALTCODE
+!!!CDIR SHORTLOOP
+      Do i=1,coeffraf
+      tabppm(1,i,1) = 0.08333333333333*(-1.+4*tabdiff2(i)-3*tabdiff3(i))
+      tabppm(2,i,1) = 0.08333333333333*
+     &              (7.-26.*tabdiff2(i)+18.*tabdiff3(i))
+      tabppm(3,i,1) =0.08333333333333*(7.+30*tabdiff2(i)-30*tabdiff3(i))
+      tabppm(4,i,1) = 0.08333333333333*
+     &              (-1.-10.*tabdiff2(i)+18.*tabdiff3(i))     
+      tabppm(5,i,1) = 0.08333333333333*(2*tabdiff2(i)-3*tabdiff3(i)) 
+      End Do   
+C 
+C
+        diffmod = 0
+       IF (mod(coeffraf,2) == 0) diffmod = 1
+C
+        ipos = i1
+C               
+        Do iparent = locind_parent_left,locind_parent_last       
+             pos=1
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+         indparentppm(jj,1) = iparent-2
+         indchildppm(jj,1) = pos
+               pos = pos+1 
+             End do 
+             ipos = ipos + coeffraf
+C
+        End do
+        
+      Return
+      End Subroutine ppm1dprecompute
+      
+      Subroutine ppm1daftercompute(x,y,np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child,dir) 
+C
+CCC   Description:
+CCC   Subroutine to do a 1D interpolation and apply monotonicity constraints
+CCC   using piecewise parabolic method  
+CCC   on a child grid (vector y) from its parent grid (vector x).
+CC    Method: Use precomputed coefficient and index
+C
+C     Declarations:
+C
+      Implicit none
+C        
+C     Arguments
+      Integer             :: np,nc,dir
+      Real, INTENT(IN),Dimension(np) :: x      
+      Real, INTENT(OUT),Dimension(nc) :: y
+C      Real, Dimension(:),Allocatable :: ytemp
+      Real                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+      Integer :: iparent,ipos,pos,nmin,nmax
+      Real    :: ypos
+      integer :: i1,jj
+      Real :: xpmin,a
+C      
+      Real :: xrmin,xrmax,am3,s2,s1  
+      Real, Dimension(np) :: xl,delta,a6,slope
+      INTEGER :: diffmod
+C      
+C
+      do i=1,nc
+      y(i)=tabppm(1,indchildppm(i,dir),dir)*x(indparentppm(i,dir))+
+     &        tabppm(2,indchildppm(i,dir),dir)*x(indparentppm(i,dir)+1)+
+     &        tabppm(3,indchildppm(i,dir),dir)*x(indparentppm(i,dir)+2)+
+     &        tabppm(4,indchildppm(i,dir),dir)*x(indparentppm(i,dir)+3)+
+     &        tabppm(5,indchildppm(i,dir),dir)*x(indparentppm(i,dir)+4)
+      enddo
+        
+      Return
+      End Subroutine ppm1daftercompute            
+      
+C     **************************************************************************  
+CCC   Subroutine weno1d
+C     ************************************************************************** 
+C 
+      Subroutine weno1dnew(x,y,np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to do a 1D interpolation and apply monotonicity constraints
+CCC   using piecewise parabolic method  
+CCC   on a child grid (vector y) from its parent grid (vector x).
+CC    Method:
+C
+C     Declarations:
+C
+      Implicit none
+C        
+C     Arguments
+      Integer             :: np,nc
+      Real, Dimension(np) :: x
+      Real, Dimension(nc) :: y
+      Real, Dimension(:),Allocatable :: ytemp
+      Real                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+      Integer :: iparent,ipos,pos,nmin,nmax
+      Real    :: ypos
+      integer :: i1,jj
+      Real :: xpmin,cavg,a,b
+C      
+      Real :: xrmin,xrmax,am3,s2,s1
+      Real, Dimension(np) :: xr,xl,delta,a6,slope,slope2,smooth
+      Real, Dimension(:),Allocatable  :: diff,diff2,diff3
+      INTEGER :: diffmod
+      REAL :: invcoeffraf
+      integer :: s,l,k
+      integer :: etan, etap
+      real :: delta0, delta1, delta2
+      real :: epsilon
+      parameter (epsilon = 1.D-8)
+      real, dimension(:,:), allocatable :: ak, ck
+C      
+      coeffraf = nint(ds_parent/ds_child)
+C
+      If (coeffraf == 1) Then
+          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+          return
+      End If
+      invcoeffraf = ds_child/ds_parent
+      Allocate(ak(0:1,coeffraf))
+      Allocate(ck(0:1,coeffraf))
+            
+C      
+      Allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
+      ypos = s_child
+C
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+      locind_parent_last = 1 +
+     &      agrif_ceiling((ypos +(nc - 1)
+     &      *ds_child - s_parent)/ds_parent)
+C
+      xpmin = s_parent + (locind_parent_left-1)*ds_parent
+      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+C     
+      Allocate( diff(coeffraf),diff2(coeffraf),diff3(coeffraf) )
+C      
+      diff(1)=0.5*invcoeffraf
+      do i=2,coeffraf
+         diff(i) = diff(i-1)+invcoeffraf
+      enddo
+      
+      ak = 0.
+      ck = 0.
+      
+      do i=1,coeffraf
+         do k=0,1
+         do s=0,2
+         do l=0,2
+           if (l /= s) then
+            ak(k,i) = ak(k,i)+(diff(i)-(k-l+1.))
+           endif
+         enddo
+         enddo
+         enddo
+               
+         etap = 0
+         etan = 0
+         do k=0,1
+          if (ak(k,i) > 0) then
+            etap = etap+1
+          else if (ak(k,i) < 0) then
+            etan = etan + 1
+          endif
+         enddo
+               
+         do k=0,1
+           if (ak(k,i) == 0) then
+            Ck(k,i) = 1.
+           else if (ak(k,i) > 0) then
+            Ck(k,i) = 1./(etap * ak(k,i))
+           else
+            Ck(k,i) = -1./(etan * ak(k,i))
+           endif
+         enddo
+      enddo
+                     
+C      
+      a = 0.
+      b = invcoeffraf
+      Do i=1,coeffraf
+         diff2(i) = 0.5*(b*b - a*a)  
+         diff3(i) = (1./3.)*(b*b*b - a*a*a)
+         a = a + invcoeffraf
+         b = b + invcoeffraf
+      End do
+C
+      if( locind_parent_last+2 <= np ) then
+           nmax = locind_parent_last+2    
+      elseif( locind_parent_last+1 <= np ) then
+           nmax = locind_parent_last+1
+      else
+           nmax = locind_parent_last 
+      endif     
+C      
+      if(locind_parent_left-2 >= 1) then
+          nmin = locind_parent_left-2
+      elseif(locind_parent_left-1 >= 1) then
+          nmin = locind_parent_left-1
+      else 
+          nmin = locind_parent_left
+      endif    
+C 
+      Do i = nmin+1,nmax
+         slope(i) = (x(i) - x(i-1))
+      Enddo 
+      DO i=nmin+2,nmax
+        smooth(i) = 0.5*(slope(i)**2+slope(i-1)**2)
+     &       +(slope(i)-slope(i-1))**2
+      enddo
+C
+        diffmod = 0
+        IF (mod(coeffraf,2) == 0) diffmod = 1           
+C
+        ipos = i1
+C               
+        Do iparent = locind_parent_left,locind_parent_last       
+             pos=1
+             
+            delta0=1./(epsilon+smooth(iparent  ))**3
+            delta1=1./(epsilon+smooth(iparent+1))**3
+            delta2=1./(epsilon+smooth(iparent+2))**3   
+                      
+             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+C
+               pos = pos+1 
+             End do 
+             ipos = ipos + coeffraf
+C
+        End do     
+C
+C
+        y(1:nc)=ytemp(1:nc)                                 
+        deallocate(ytemp)                
+        deallocate(diff, diff2, diff3)
+        
+        deallocate(ak,ck)
+        
+      Return
+      End Subroutine weno1dnew
+      
+C     **************************************************************************  
+CCC   Subroutine weno1d
+C     ************************************************************************** 
+C 
+      Subroutine weno1d(x,y,np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to do a 1D interpolation and apply monotonicity constraints
+CCC   using piecewise parabolic method  
+CCC   on a child grid (vector y) from its parent grid (vector x).
+CC    Method:
+C
+C     Declarations:
+C
+      Implicit none
+C        
+C     Arguments
+      Integer             :: np,nc
+      Real, Dimension(np) :: x
+      Real, Dimension(nc) :: y
+      Real, Dimension(:),Allocatable :: ytemp
+      Real                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+      Integer :: iparent,ipos,pos,nmin,nmax
+      Real    :: ypos
+      integer :: i1,jj
+      Real :: xpmin,cavg,a,b
+C      
+      Real :: xrmin,xrmax,am3,s2,s1
+      Real, Dimension(np) :: xr,xl,delta,a6,slope,slope2
+      Real, Dimension(:),Allocatable  :: diff,diff2,diff3
+      INTEGER :: diffmod
+      REAL :: invcoeffraf
+      integer :: s,l,k
+      integer :: etan, etap
+      real :: delta0, delta1,sumdelta
+      real :: epsilon
+      parameter (epsilon = 1.D-8)
+C      
+      coeffraf = nint(ds_parent/ds_child)
+C
+      If (coeffraf == 1) Then
+          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+          return
+      End If
+      invcoeffraf = ds_child/ds_parent
+            
+C      
+      Allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
+      ypos = s_child
+C
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+      locind_parent_last = 1 +
+     &      agrif_ceiling((ypos +(nc - 1)
+     &      *ds_child - s_parent)/ds_parent)
+C
+      xpmin = s_parent + (locind_parent_left-1)*ds_parent
+      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+C     
+      Allocate( diff(coeffraf))
+C      
+      diff(1)=0.5*invcoeffraf
+      do i=2,coeffraf
+         diff(i) = diff(i-1)+invcoeffraf
+      enddo
+C
+      if( locind_parent_last+2 <= np ) then
+           nmax = locind_parent_last+2   
+      else if( locind_parent_last+1 <= np ) then
+           nmax = locind_parent_last+1
+      else
+           nmax = locind_parent_last 
+      endif     
+C      
+      if(locind_parent_left-1 >= 1) then
+          nmin = locind_parent_left-1
+      else 
+          nmin = locind_parent_left
+      endif    
+C 
+      Do i = nmin+1,nmax
+         slope(i) = (x(i) - x(i-1))
+      Enddo 
+C
+        diffmod = 0
+        IF (mod(coeffraf,2) == 0) diffmod = 1           
+C
+        ipos = i1
+C               
+        Do iparent = locind_parent_left,locind_parent_last       
+             pos=1
+            delta0=1./(epsilon+slope(iparent  )**2)**2
+            delta1=1./(epsilon+slope(iparent+1)**2)**2
+            sumdelta = 1./(delta0+delta1)             
+             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+C                              
+          ytemp(jj) = x(iparent)+(diff(pos)-0.5)*(
+     &                delta0*slope(iparent)+
+     &                delta1*slope(iparent+1))*sumdelta
+               pos = pos+1 
+             End do 
+             ipos = ipos + coeffraf
+C
+        End do     
+C
+C
+        y(1:nc)=ytemp(1:nc)                                 
+        deallocate(ytemp)                
+        deallocate(diff)
+        
+      Return
+      End Subroutine weno1d
+                 
+C                              
+C     **************************************************************************  
+CCC   Subroutine eno1d
+C     ************************************************************************** 
+C 
+      Subroutine eno1d(x,y,np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   ---- p 163-164 Computational gasdynamics ----
+CCC   Subroutine to do a 1D interpolation 
+CCC   using piecewise polynomial ENO reconstruction technique  
+CCC   on a child grid (vector y) from its parent grid (vector x).
+CC    Method:
+C
+C     Declarations:
+C
+      Implicit none
+C        
+C     Arguments
+      Integer             :: np,nc      
+      Real, Dimension(np) :: x      
+      Real, Dimension(nc) :: y
+      Real, Dimension(:),Allocatable :: ytemp
+      Real                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+      Integer :: ipos,pos
+      Real    :: ypos,xi
+      integer :: i1,jj
+      Real :: xpmin,cavg
+C 
+      Real, Dimension(3,np) :: dd,c
+      Integer :: left
+C           
+      Real, DImension(1:np+1) :: xhalf
+      Real, Dimension(:,:),Allocatable  :: Xbar 
+      INTEGER :: diffmod     
+C
+      coeffraf = nint(ds_parent/ds_child)
+C      
+      If (coeffraf == 1) Then
+          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+          return
+      End If     
+      
+      diffmod = 0
+      IF (mod(coeffraf,2) == 0) diffmod = 1  
+C      
+      Allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
+      ypos = s_child  
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) 
+      locind_parent_last = 1 +
+     &      agrif_ceiling((ypos +(nc - 1) *ds_child - 
+     &      s_parent)/ds_parent)       
+      xpmin = s_parent + (locind_parent_left-1)*ds_parent      
+      i1 = 1+agrif_int((xpmin-s_child)/ds_child)           
+C      
+      xhalf(np+1) = np + 0.5
+      Do i = 1,np
+          xhalf(i) = i - 0.5
+      Enddo
+C
+C compute divided differences
+C
+      dd(1,1:np) = x(1:np)
+      dd(2,1:np-1) = 0.5*( dd(1,2:np) - dd(1,1:np-1) )
+      dd(3,1:np-2) = (1./3.)*( dd(2,2:np-1) - dd(2,1:np-2) )
+C
+      Allocate( Xbar( coeffraf,2 ) )
+      xi = 0.5
+      Do i = 1,coeffraf
+        Xbar(i,1) = (i-1)*ds_child/ds_parent - xi
+        Xbar(i,2) = i*ds_child/ds_parent - xi
+      Enddo
+C
+      ipos = i1
+C           
+      DO i = locind_parent_left,locind_parent_last           
+         left = i           
+         do jj = 2,3
+             If(abs(dd(jj,left)) .gt. abs(dd(jj,left-1)))
+     &               left = left-1            
+         enddo
+C           
+C  convert to Taylor series form
+C
+         Call Taylor(i,xhalf(left:left+2),dd(1:3,left),c(1:3,i))
+      ENDDO     
+C
+C evaluate the reconstruction on each cell
+C
+       DO i = locind_parent_left,locind_parent_last  
+C
+         cavg = 0.
+         pos = 1.            
+C         
+         Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+           ytemp(jj) =(c(1,i)*(Xbar(pos,2)-Xbar(pos,1))
+     &                +c(2,i)*(Xbar(pos,2)*Xbar(pos,2)-
+     &                         Xbar(pos,1)*Xbar(pos,1))
+     &                +c(3,i)*(Xbar(pos,2)*Xbar(pos,2)*Xbar(pos,2)-
+     &                         Xbar(pos,1)*Xbar(pos,1)*Xbar(pos,1)))
+     &                         *coeffraf
+           cavg = cavg + ytemp(jj)
+           pos = pos+1
+         Enddo                
+         ipos = ipos + coeffraf                 
+      ENDDO
+C
+      y(1:nc)=ytemp(1:nc)                                            
+      deallocate(ytemp,Xbar)                 
+C      
+      Return       
+      End Subroutine eno1d
+C 
+C      
+C     **************************************************************************  
+CCC   Subroutine taylor
+C     ************************************************************************** 
+C       
+      subroutine taylor(ind,xhalf,dd,c)      
+C      
+      Integer :: ind
+      real,dimension(3) :: dd,c     
+      real,dimension(0:3,0:3) :: d 
+      real,dimension(3) :: xhalf    
+      integer ::i,j
+C      
+C
+      d(0,0:3)=1.
+      do i = 1,3
+         d(i,0)=(ind-xhalf(i))*d(i-1,0)
+      enddo  
+C      
+      do i = 1,3
+         do j = 1,3-i
+           d(i,j) = d(i,j-1) + (ind-xhalf(i+j))*d(i-1,j)
+         enddo
+      enddo
+C         
+      do j = 1,3        
+         c(j) = 0.
+         do i=0,3-j
+            c(j) = c(j) + d(i,j)*dd(i+j)         
+         enddo
+      enddo
+C      
+      end subroutine taylor    
+      
+      
+      REAL FUNCTION vanleer(tab)
+      REAL, DIMENSION(3) :: tab
+       real res1
+       real p1,p2,p3
+       
+       p1=(tab(3)-tab(1))/2.
+       p2=2.*(tab(2)-tab(1))
+       p3=2.*(tab(3)-tab(2))
+       
+       if ((p1>0.).AND.(p2>0.).AND.(p3>0)) then
+          res1=minval((/p1,p2,p3/))
+       elseif ((p1<0.).AND.(p2<0.).AND.(p3<0)) then
+          res1=maxval((/p1,p2,p3/))
+       else
+          res1=0.
+       endif
+          
+          vanleer = res1   
+      
+      
+      END FUNCTION vanleer 
+
+C      
+      End Module Agrif_Interpbasic
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modlinktomodel.F
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modlinktomodel.F	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modlinktomodel.F	(revision 8201)
@@ -0,0 +1,186 @@
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place -  Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+      Module Agrif_link
+C
+CCC   Description:
+CCC   This module is used to link AGRIF files to the model
+C
+C     Modules used: 
+C
+c        external Agrif_InitValues
+c        external Agrif_detect
+C
+        external Agrif_InitWorkspace
+        external Agrif_probdim_modtype_def
+        external Agrif_clustering_def
+        external Agrif_comm_def
+C     Interface                       
+      INTERFACE
+      SUBROUTINE  Sub_Loop_Agrif_InvLoc(indloc,nprocloc,i,
+     &            indglob,njmppt,nimppt)
+      INTEGER :: indglob
+      INTEGER :: indloc
+      INTEGER :: nprocloc
+      INTEGER :: i
+
+      INTEGER, ALLOCATABLE, Dimension(:) :: njmppt
+      INTEGER, ALLOCATABLE, Dimension(:) :: nimppt
+      END SUBROUTINE
+      END INTERFACE
+      Interface
+         Subroutine Agrif_Set_numberofcells(Agrif_Gr)
+         Use Agrif_Types, Only : Agrif_grid
+         TYPE(Agrif_Grid), Pointer :: Agrif_Gr   ! Pointer on the current grid  
+         End Subroutine Agrif_Set_numberofcells
+      End interface
+      Interface
+         Subroutine Agrif_Get_numberofcells(Agrif_Gr)
+         Use Agrif_Types, Only : Agrif_grid
+         TYPE(Agrif_Grid), Pointer :: Agrif_Gr   ! Pointer on the current grid  
+         End Subroutine Agrif_Get_numberofcells
+      End interface
+      Interface
+         Subroutine Agrif_Allocationcalls(Agrif_Gr)
+         Use Agrif_Types, Only : Agrif_grid
+         TYPE(Agrif_Grid), Pointer :: Agrif_Gr   ! Pointer on the current grid  
+         End Subroutine Agrif_Allocationcalls
+      End interface
+C   
+      End Module Agrif_link
+C     **************************************************************************
+CCC   Function Agrif_parent
+C        modify by conv. To use : un_parent = Agrif_Parent(un)
+C     **************************************************************************
+CCC   Function Agrif_Get_Coarse_Grid
+C        modify by conv. To use : un_Mygrid = Agrif_Get_Coarse_grid(un)
+C     **************************************************************************
+CCC   Function Agrif_Rhox
+C        modify by conv. To use : var = Agrif_Rhox()
+C                    REAL(Agrif_Curgrid % spaceref(1))
+C     **************************************************************************
+CCC   Function Agrif_Parent_Rhox
+C        modify by conv. To use : var = Agrif_Parent_Rhox()
+C                    REAL(Agrif_Curgrid % parent % spaceref(1))
+C     **************************************************************************
+CCC   Function Agrif_Irhox
+C        modify by conv. To use : var = Agrif_Parent_IRhox()
+C                    Agrif_Curgrid % spaceref(1)
+C     **************************************************************************
+CCC   Function Agrif_Parent_Irhox
+C        modify by conv. To use : var = Agrif_Parent_IRhox()
+C                    Agrif_Curgrid % parent % spaceref(1)
+C     **************************************************************************
+CCC   Function Agrif_Rhoy
+C        modify by conv. To use : var = Agrif_Rhoy()
+C                    REAL(Agrif_Curgrid % spaceref(2))
+C     **************************************************************************
+CCC   Function Agrif_Parent_Rhoy
+C        modify by conv. To use : var = Agrif_Parent_Rhoy()
+C                    REAL(Agrif_Curgrid % parent % spaceref(2))
+C     **************************************************************************
+CCC   Function Agrif_Irhoy
+C        modify by conv. To use : var = Agrif_Parent_IRhoy()
+C                    Agrif_Curgrid % spaceref(2)
+C     **************************************************************************
+CCC   Function Agrif_Parent_Irhoy
+C        modify by conv. To use : var = Agrif_Parent_IRhoy()
+C                    Agrif_Curgrid % parent % spaceref(2)
+C     **************************************************************************
+CCC   Function Agrif_Rhoz
+C        modify by conv. To use : var = Agrif_Rhoz()
+C                    REAL(Agrif_Curgrid % spaceref(3))
+C     **************************************************************************
+CCC   Function Agrif_Parent_Rhoz
+C        modify by conv. To use : var = Agrif_Parent_Rhoz()
+C                    REAL(Agrif_Curgrid % parent % spaceref(3))
+C     **************************************************************************
+CCC   Function Agrif_Irhoz
+C        modify by conv. To use : var = Agrif_Parent_IRhoz()
+C                    Agrif_Curgrid % spaceref(3)
+C     **************************************************************************
+CCC   Function Agrif_Parent_Irhoz
+C        modify by conv. To use : var = Agrif_Parent_IRhoz()
+C                    Agrif_Curgrid % parent % spaceref(3)
+C     **************************************************************************
+CCC   Function Agrif_NearCommonBorderX
+C        modify by conv. To use : var = Agrif_NearCommonBorderX()
+C                       AGRIF_CURGRID % NearRootBorder(1)
+C     **************************************************************************
+CCC   Function Agrif_NearCommonBorderY
+C        modify by conv. To use : var = Agrif_NearCommonBorderY()
+C                       AGRIF_CURGRID % NearRootBorder(2)
+C     **************************************************************************
+CCC   Function Agrif_NearCommonBorderZ
+C        modify by conv. To use : var = Agrif_NearCommonBorderZ()
+C                       AGRIF_CURGRID % NearRootBorder(3)
+C     **************************************************************************
+CCC   Function Agrif_DistantCommonBorderX
+C        modify by conv. To use : var = Agrif_DistantCommonBorderX()
+C                       AGRIF_CURGRID % DistantRootBorder(1)
+C     **************************************************************************
+CCC   Function Agrif_DistantCommonBorderY
+C        modify by conv. To use : var = Agrif_DistantCommonBorderY()
+C                       AGRIF_CURGRID % DistantRootBorder(2)
+C     **************************************************************************
+CCC   Function Agrif_DistantCommonBorderZ
+C        modify by conv. To use : var = Agrif_DistantCommonBorderZ()
+C                       AGRIF_CURGRID % DistantRootBorder(3)
+C     **************************************************************************
+CCC   Function Agrif_Nb_Step
+C        modify by conv. To use : var = Agrif_Nb_Step()
+C                          AGRIF_CURGRID % ngridstep
+C     **************************************************************************
+CCC   Function Agrif_Nb_Fine_Grids
+C        modify by conv. To use : var = Agrif_Nb_Fine_Grids()
+C                         Agrif_nbfixedgrids 
+C     **************************************************************************
+CCC   Function Agrif_Ix
+C        modify by conv. To use : var = Agrif_Ix()
+C                         Agrif_CURGRID % ix(1) 
+C     **************************************************************************
+CCC   Function Agrif_Parent_Ix
+C        modify by conv. To use : var = Agrif_Parent_Ix()
+C                        Agrif_CURGRID % parent % ix(1) 
+C     **************************************************************************
+CCC   Function Agrif_Iy
+C        modify by conv. To use : var = Agrif_Iy()
+C                        AGRIF_CURGRID % ix(2) 
+C     **************************************************************************
+CCC   Function Agrif_Parent_Iy
+C        modify by conv. To use : var = Agrif_Parent_Iy()
+C                       Agrif_CURGRID % parent % ix(2) 
+C     **************************************************************************
+CCC   Function Agrif_Iz
+C        modify by conv. To use : var = Agrif_Iz()
+C                      AGRIF_CURGRID % ix(3) 
+C     **************************************************************************
+CCC   Function Agrif_Parent_Iz
+C        modify by conv. To use : var = Agrif_Parent_Iz()
+C                     Agrif_CURGRID % parent % ix(3) 
+C     **************************************************************************
+CCC   Function Agrif_Get_grid_id
+C        modify by conv. To use : var = Agrif_Get_grid_id()
+C                    Agrif_CURGRID % grid_id
+C     **************************************************************************
+CCC   Function Agrif_Get_parent_id
+C        modify by conv. To use : var = Agrif_Get_parent_id()
+C                    Agrif_CURGRID % parent % grid_id
+C     **************************************************************************
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmask.F
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmask.F	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmask.F	(revision 8201)
@@ -0,0 +1,688 @@
+!
+! $Id: modmask.F 2528 2010-12-27 17:33:53Z rblod $
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place -  Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_Mask
+C
+      Module Agrif_Mask
+C
+CCC   Description:
+CCC   Module for masks
+C
+C     Modules used: 
+C
+      Use Agrif_Types       
+C
+      IMPLICIT NONE
+C
+      CONTAINS
+C     Define procedures contained in this module
+C
+C     **************************************************************************
+C     Subroutine Agrif_CheckMasknD
+C     **************************************************************************
+C       
+      Subroutine Agrif_CheckMasknD(tempP,parent,pbtab,petab,ppbtab,
+     &               ppetab,noraftab,nbdim)
+C
+CCC   Description:
+CCC   Subroutine called in the procedure Agrif_InterpnD to recalculate the value 
+CCC   of the parent grid variable when this one is equal to Agrif_SpecialValue. 
+C
+C     Declarations:
+C
+       
+C
+C     Arrays arguments      
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim) :: pbtab  ! Limits of the parent grid used  
+      INTEGER,DIMENSION(nbdim) :: petab  ! interpolation of the child grid
+      LOGICAL,DIMENSION(nbdim) :: noraftab
+      INTEGER,DIMENSION(nbdim) :: ppbtab,ppetab
+C
+C     Pointer argument
+      TYPE(AGRIF_PVARIABLE) :: tempP  ! Part of the parent grid used for 
+                                      ! the interpolation of the child grid                     
+C     Data TYPE argument                                   
+      TYPE(AGRIF_PVARIABLE) :: parent      ! The parent grid
+C
+C     Local scalar
+      INTEGER                   :: i0,j0,k0,l0,m0,n0
+C      
+C     Local arrays
+C
+C      
+      SELECT CASE (nbdim)
+      CASE (1)
+         do i0 = pbtab(1),petab(1)
+         IF (tempP%var%array1(i0)
+     &                        == Agrif_SpecialValue) Then
+            Call CalculNewValTempP((/i0/),
+     &                             tempP,parent,
+     &                             ppbtab,ppetab,
+     &                             noraftab,nbdim)
+         ENDIF
+         enddo
+      CASE (2)
+         do j0 = pbtab(2),petab(2)
+         do i0 = pbtab(1),petab(1)
+         IF (tempP%var%array2(i0,j0)
+     &                        == Agrif_SpecialValue) Then
+            Call CalculNewValTempP((/i0,j0/),
+     &                             tempP,parent,
+     &                             ppbtab,ppetab,
+     &                             noraftab,nbdim)
+         ENDIF
+         enddo  
+         enddo
+      CASE (3)
+         do k0 = pbtab(3),petab(3)
+         do j0 = pbtab(2),petab(2)
+         do i0 = pbtab(1),petab(1)
+         IF (tempP%var%array3(i0,j0,k0)
+     &                        == Agrif_SpecialValue) Then
+!------CDIR NEXPAND
+            Call CalculNewValTempP3D((/i0,j0,k0/),
+     &      tempP%var%array3(ppbtab(1),ppbtab(2),ppbtab(3)),
+     &      parent%var%array3(ppbtab(1),ppbtab(2),ppbtab(3)),
+     &                           ppbtab,ppetab,
+     &                           noraftab,MaxSearch,Agrif_SpecialValue)
+     
+c            Call CalculNewValTempP((/i0,j0,k0/),
+c     &                             tempP,parent,
+c     &                             ppbtab,ppetab,
+c     &                             noraftab,nbdim)
+          
+         ENDIF
+         enddo
+         enddo  
+         enddo
+      CASE (4)
+         do l0 = pbtab(4),petab(4)
+         do k0 = pbtab(3),petab(3)
+         do j0 = pbtab(2),petab(2)
+         do i0 = pbtab(1),petab(1)
+         IF (tempP%var%array4(i0,j0,k0,l0) 
+     &                        == Agrif_SpecialValue) Then
+            Call CalculNewValTempP4D((/i0,j0,k0,l0/),
+     &      tempP%var%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)),
+     &      parent%var%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)),
+     &                           ppbtab,ppetab,
+     &                           noraftab,MaxSearch,Agrif_SpecialValue)
+         ENDIF
+         enddo
+         enddo
+         enddo  
+         enddo
+      CASE (5)
+         do m0 = pbtab(5),petab(5)
+         do l0 = pbtab(4),petab(4)
+         do k0 = pbtab(3),petab(3)
+         do j0 = pbtab(2),petab(2)
+         do i0 = pbtab(1),petab(1)
+         IF (tempP%var%array5(i0,j0,k0,l0,m0) 
+     &                       == Agrif_SpecialValue) Then
+            Call CalculNewValTempP((/i0,j0,k0,l0,m0/),
+     &                             tempP,parent,
+     &                             ppbtab,ppetab,
+     &                             noraftab,nbdim)
+         ENDIF
+         enddo
+         enddo
+         enddo  
+         enddo
+         enddo
+      CASE (6)
+         do n0 = pbtab(6),petab(6)
+         do m0 = pbtab(5),petab(5)
+         do l0 = pbtab(4),petab(4)
+         do k0 = pbtab(3),petab(3)
+         do j0 = pbtab(2),petab(2)
+         do i0 = pbtab(1),petab(1)
+         IF (tempP%var%array6(i0,j0,k0,l0,m0,n0) 
+     &                       == Agrif_SpecialValue) Then
+            Call CalculNewValTempP((/i0,j0,k0,l0,m0,n0/),
+     &                             tempP,parent,
+     &                             ppbtab,ppetab,
+     &                             noraftab,nbdim)
+         ENDIF
+         enddo
+         enddo
+         enddo
+         enddo  
+         enddo
+         enddo
+      END SELECT
+C
+C      
+C     
+      End Subroutine Agrif_CheckMasknD
+C
+C
+C     **************************************************************************
+C     Subroutine CalculNewValTempP
+C     **************************************************************************
+C       
+      Subroutine CalculNewValTempP(indic,
+     &               tempP,parent,ppbtab,
+     &               ppetab,noraftab,nbdim)
+C
+CCC   Description:
+CCC   Subroutine called in the procedure Agrif_InterpnD to recalculate the value 
+CCC   of the parent grid variable when this one is equal to Agrif_SpecialValue. 
+C
+C     Declarations:
+C
+       
+C
+C     Arrays arguments      
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim) :: indic
+      LOGICAL,DIMENSION(nbdim) :: noraftab
+      INTEGER,DIMENSION(nbdim) :: ppbtab,ppetab
+C
+C     Pointer argument
+      TYPE(AGRIF_PVARIABLE) :: tempP  ! Part of the parent grid used for 
+                                      ! the interpolation of the child grid                     
+C     Data TYPE argument                                   
+      TYPE(AGRIF_PVARIABLE) :: parent      ! The parent grid
+C
+C     Local scalar
+      INTEGER                  :: i,ii,iii,jj,kk,ll,mm,nn 
+      INTEGER,DIMENSION(nbdim) :: imin,imax,idecal
+      INTEGER                  :: Nbvals
+      REAL                     :: Res
+      REAL                     :: ValParent
+      INTEGER                  :: ValMax
+      LOGICAL                  :: firsttest
+C      
+C     Local arrays      
+C
+      ValMax = 1
+      do iii = 1 , nbdim
+         IF (.NOT.noraftab(iii)) THEN
+         ValMax = max(ValMax,ppetab(iii)-indic(iii))
+         ValMax = max(ValMax,indic(iii)-ppbtab(iii))
+         ENDIF
+      enddo
+C
+      Valmax = min(Valmax,MaxSearch)
+C
+!CDIR NOVECTOR
+      imin = indic
+!CDIR NOVECTOR
+      imax = indic
+C
+         i = 1
+         firsttest = .TRUE.
+C
+         do While(i <= ValMax)
+C
+         IF ((i == 1).AND.(firsttest)) i = Valmax
+
+            do iii = 1 , nbdim
+               if (.NOT.noraftab(iii)) then
+                  imin(iii) = max(indic(iii) - i,ppbtab(iii))
+                  imax(iii) = min(indic(iii) + i,ppetab(iii))
+                  if (firsttest) then               
+                  if (indic(iii).GT.ppbtab(iii)) then
+
+!CDIR NOVECTOR
+                     idecal = indic
+                     idecal(iii) = idecal(iii)-1
+                     SELECT CASE(nbdim)
+                     CASE (1)
+                        if (tempP%var%array1(idecal(1)
+     &                            ) == Agrif_SpecialValue) then
+                           imin(iii) = imax(iii)
+                        endif                     
+                     CASE (2)
+                        if (tempP%var%array2(idecal(1),
+     &            idecal(2)) == Agrif_SpecialValue) then
+                           imin(iii) = imax(iii)
+                        endif
+                     CASE (3)
+                        if (tempP%var%array3(idecal(1),
+     &            idecal(2),idecal(3)) 
+     &                               == Agrif_SpecialValue) then
+                           imin(iii) = imax(iii)
+                        endif  
+                     CASE (4)
+                        if (tempP%var%array4(idecal(1),
+     &            idecal(2),idecal(3),idecal(4)) 
+     &                               == Agrif_SpecialValue) then
+                           imin(iii) = imax(iii)
+                        endif     
+                     CASE (5)
+                        if (tempP%var%array5(idecal(1),
+     &            idecal(2),idecal(3),idecal(4),idecal(5)) 
+     &                               == Agrif_SpecialValue) then
+                           imin(iii) = imax(iii)
+                        endif  
+                     CASE (6)
+                        if (tempP%var%array6(idecal(1),
+     &            idecal(2),idecal(3),idecal(4),idecal(5),idecal(6)) 
+     &                               == Agrif_SpecialValue) then
+                           imin(iii) = imax(iii)
+                        endif                                                                                           
+                     END SELECT
+                  endif
+                  endif
+               endif            
+            enddo
+C
+            Res = 0.
+            Nbvals = 0
+C
+            SELECT CASE(nbdim)
+            CASE (1)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+               do ii = imin(1),imax(1)
+                    ValParent = parent%var%array1(ii)
+                    if ( ValParent .NE. Agrif_SpecialValue) then
+                        Res = Res + ValParent
+                        Nbvals = Nbvals + 1
+                    endif 
+               enddo
+C
+            CASE (2)
+               do jj = imin(2),imax(2)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+               do ii = imin(1),imax(1)
+                    ValParent = parent%var%array2(ii,jj)
+                    if ( ValParent .NE. Agrif_SpecialValue) then
+                        Res = Res + ValParent
+                        Nbvals = Nbvals + 1
+                    endif 
+               enddo  
+               enddo
+               
+            CASE (3)
+               do kk = imin(3),imax(3)
+               do jj = imin(2),imax(2)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+               do ii = imin(1),imax(1)
+                    ValParent = parent%var%array3(ii,jj,kk)
+                    if ( ValParent .NE. Agrif_SpecialValue) then
+                        Res = Res + ValParent
+                        Nbvals = Nbvals + 1
+                    endif 
+                        enddo
+                  enddo  
+               enddo
+
+            CASE (4)
+               do ll = imin(4),imax(4)
+               do kk = imin(3),imax(3)
+               do jj = imin(2),imax(2)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+               do ii = imin(1),imax(1)
+                    ValParent = parent%var%array4(ii,jj,kk,ll)
+                    if ( ValParent .NE. Agrif_SpecialValue) then
+                        Res = Res + ValParent
+                        Nbvals = Nbvals + 1
+                    endif 
+                              enddo
+                        enddo
+                  enddo  
+               enddo
+
+            CASE (5)
+               do mm = imin(5),imax(5)
+               do ll = imin(4),imax(4)
+               do kk = imin(3),imax(3)
+               do jj = imin(2),imax(2)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+               do ii = imin(1),imax(1)
+                    ValParent = parent%var%array5(ii,jj,kk,ll,mm)
+                    if ( ValParent .NE. Agrif_SpecialValue) then
+                        Res = Res + ValParent
+                        Nbvals = Nbvals + 1
+                    endif 
+                                    enddo
+                              enddo
+                        enddo
+                  enddo  
+               enddo
+
+            CASE (6)
+               do nn = imin(6),imax(6)
+               do mm = imin(5),imax(5)
+               do ll = imin(4),imax(4)
+               do kk = imin(3),imax(3)
+               do jj = imin(2),imax(2)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+               do ii = imin(1),imax(1)
+                    ValParent = parent%var%array6(ii,jj,kk,ll,mm,nn)
+                    if ( ValParent .NE. Agrif_SpecialValue) then
+                        Res = Res + ValParent
+                        Nbvals = Nbvals + 1
+                    endif 
+                                          enddo
+                                    enddo
+                              enddo
+                        enddo
+                  enddo  
+               enddo
+
+            END SELECT
+C
+C
+            
+            if (Nbvals.GT.0) then
+              if (firsttest) then
+                   firsttest = .FALSE.
+                   i=1
+                   cycle
+              endif
+            SELECT CASE(nbdim)
+            CASE (1)              
+              tempP%var%array1(indic(1)) 
+     &           = Res/Nbvals
+            CASE (2)
+              tempP%var%array2(indic(1),
+     &                            indic(2)) = Res/Nbvals
+            CASE (3)
+              tempP%var%array3(indic(1),
+     &                            indic(2),indic(3)) = Res/Nbvals
+            CASE (4)
+              tempP%var%array4(indic(1),
+     &                            indic(2),indic(3),indic(4))
+     &                = Res/Nbvals
+            CASE (5)
+              tempP%var%array5(indic(1),
+     &                            indic(2),indic(3),indic(4),
+     &                   indic(5)) = Res/Nbvals
+            CASE (6)
+              tempP%var%array6(indic(1),
+     &                            indic(2),indic(3),indic(4),
+     &                           indic(5),indic(6)) = Res/Nbvals
+            END SELECT
+              exit
+            else
+               if (firsttest) exit
+               i = i + 1                      
+            endif
+          enddo            
+C     
+      End Subroutine CalculNewValTempP
+C
+C
+      End Module Agrif_Mask     
+      
+      Subroutine CalculNewValTempP3D(indic,
+     &               tempP,parent,ppbtab,
+     &               ppetab,noraftab,MaxSearch,Agrif_SpecialValue)
+C
+CCC   Description:
+CCC   Subroutine called in the procedure Agrif_InterpnD to recalculate the value 
+CCC   of the parent grid variable when this one is equal to Agrif_SpecialValue. 
+C
+C     Declarations:
+C
+       
+C
+C     Arrays arguments      
+      INTEGER, PARAMETER :: nbdim = 3
+      INTEGER,DIMENSION(nbdim) :: indic
+      LOGICAL,DIMENSION(nbdim) :: noraftab
+      INTEGER,DIMENSION(nbdim) :: ppbtab,ppetab
+      REAL :: Agrif_SpecialValue
+C
+C     Pointer argument
+      REAL,DIMENSION(ppbtab(1):ppetab(1),ppbtab(2):ppetab(2),
+     &    ppbtab(3):ppetab(3)) :: tempP, parent  ! Part of the parent grid used for 
+                                      ! the interpolation of the child grid                     
+C
+C     Local scalar
+      INTEGER                  :: i,ii,iii,jj,kk,ll,mm,nn 
+      INTEGER,DIMENSION(nbdim) :: imin,imax,idecal
+      INTEGER                  :: Nbvals
+      REAL                     :: Res
+      REAL                     :: ValParent
+      INTEGER                  :: ValMax
+      INTEGER :: MaxSearch
+      LOGICAL :: Existunmasked
+C      
+C     Local arrays      
+C
+      ValMax = 1
+!CDIR NOVECTOR
+      do iii = 1 , nbdim
+         IF (.NOT.noraftab(iii)) THEN
+         ValMax = max(ValMax,ppetab(iii)-indic(iii))
+         ValMax = max(ValMax,indic(iii)-ppbtab(iii))
+         ENDIF
+      enddo
+C
+      Valmax = min(Valmax,MaxSearch)
+C
+!CDIR NOVECTOR
+      imin = indic
+!CDIR NOVECTOR
+      imax = indic
+      
+!CDIR NOVECTOR
+         idecal = indic	 
+C
+         i = Valmax
+
+            do iii = 1 , nbdim
+               if (.NOT.noraftab(iii)) then
+                  imin(iii) = max(indic(iii) - i,ppbtab(iii))
+                  imax(iii) = min(indic(iii) + i,ppetab(iii))
+         
+                  if (indic(iii).GT.ppbtab(iii)) then
+
+                     idecal(iii) = idecal(iii)-1
+
+                        if (tempP(idecal(1),idecal(2),idecal(3)) 
+     &                               == Agrif_SpecialValue) then
+                           imin(iii) = imax(iii)
+                        endif
+
+                     idecal(iii) = idecal(iii)+1
+                  endif
+
+               endif            
+            enddo
+C
+            Existunmasked = .FALSE.
+C
+               do kk = imin(3),imax(3)
+               do jj = imin(2),imax(2)
+!CDIR NOVECTOR
+               do ii = imin(1),imax(1)
+                    if ( parent(ii,jj,kk) .NE. Agrif_SpecialValue) then
+                        Existunmasked = .TRUE.
+                       exit
+                    endif 
+                        enddo
+                  enddo  
+               enddo
+C
+C
+          if (.Not.Existunmasked) return
+C
+         i = 1
+C
+         do While(i <= ValMax)
+C
+
+            do iii = 1 , nbdim
+               if (.NOT.noraftab(iii)) then
+                  imin(iii) = max(indic(iii) - i,ppbtab(iii))
+                  imax(iii) = min(indic(iii) + i,ppetab(iii))
+               endif            
+            enddo
+C
+            Res = 0.
+            Nbvals = 0
+C
+               do kk = imin(3),imax(3)
+               do jj = imin(2),imax(2)
+!CDIR NOVECTOR
+               do ii = imin(1),imax(1)
+                    ValParent = parent(ii,jj,kk)
+                    if ( ValParent .NE. Agrif_SpecialValue) then
+                        Res = Res + ValParent
+                        Nbvals = Nbvals + 1
+                    endif 
+                        enddo
+                  enddo  
+               enddo
+C
+C
+            
+            if (Nbvals.GT.0) then
+              tempP(indic(1),indic(2),indic(3)) = Res/Nbvals
+              exit
+            else
+               i = i + 1                      
+            endif
+          enddo            
+C     
+      End Subroutine CalculNewValTempP3D        
+
+      Subroutine CalculNewValTempP4D(indic,
+     &               tempP,parent,ppbtab,
+     &               ppetab,noraftab,MaxSearch,Agrif_SpecialValue)
+C
+CCC   Description:
+CCC   Subroutine called in the procedure Agrif_InterpnD to recalculate the value 
+CCC   of the parent grid variable when this one is equal to Agrif_SpecialValue. 
+C
+C     Declarations:
+C
+       
+C
+C     Arrays arguments      
+      INTEGER, PARAMETER :: nbdim = 4
+      INTEGER,DIMENSION(nbdim) :: indic
+      LOGICAL,DIMENSION(nbdim) :: noraftab
+      INTEGER,DIMENSION(nbdim) :: ppbtab,ppetab
+      INTEGER :: MaxSearch      
+      REAL :: Agrif_SpecialValue      
+C
+C     Pointer argument
+      REAL,DIMENSION(ppbtab(1):ppetab(1),ppbtab(2):ppetab(2),
+     &    ppbtab(3):ppetab(3),
+     &    ppbtab(4):ppetab(4)) :: tempP, parent  ! Part of the parent grid used for 
+                                      ! the interpolation of the child grid                     
+C
+C     Local scalar
+      INTEGER                  :: i,ii,iii,jj,kk,ll,mm,nn 
+      INTEGER,DIMENSION(nbdim) :: imin,imax,idecal
+      INTEGER                  :: Nbvals
+      REAL                     :: Res
+      REAL                     :: ValParent
+      INTEGER                  :: ValMax
+      LOGICAL                  :: firsttest
+C      
+C     Local arrays      
+C
+      ValMax = 1
+      do iii = 1 , nbdim
+         IF (.NOT.noraftab(iii)) THEN
+         ValMax = max(ValMax,ppetab(iii)-indic(iii))
+         ValMax = max(ValMax,indic(iii)-ppbtab(iii))
+         ENDIF
+      enddo
+C
+      Valmax = min(Valmax,MaxSearch)
+C
+      imin = indic
+      imax = indic
+C
+         i = 1
+         firsttest = .TRUE.
+         idecal = indic	 
+	 
+C
+         do While(i <= ValMax)
+C
+         IF ((i == 1).AND.(firsttest)) i = Valmax
+
+            do iii = 1 , nbdim
+               if (.NOT.noraftab(iii)) then
+                  imin(iii) = max(indic(iii) - i,ppbtab(iii))
+                  imax(iii) = min(indic(iii) + i,ppetab(iii))
+                  if (firsttest) then               
+                  if (indic(iii).GT.ppbtab(iii)) then
+
+
+                     idecal(iii) = idecal(iii)-1
+		     
+                     if (tempP(idecal(1),idecal(2),idecal(3),idecal(4))
+     &                               == Agrif_SpecialValue) then
+                           imin(iii) = imax(iii)
+                     endif
+		     
+		     idecal(iii) = idecal(iii)+1
+                  endif
+                  endif
+               endif            
+            enddo
+C
+            Res = 0.
+            Nbvals = 0
+C
+               do ll = imin(4),imax(4)
+               do kk = imin(3),imax(3)
+               do jj = imin(2),imax(2)
+               do ii = imin(1),imax(1)
+                    ValParent = parent(ii,jj,kk,ll)
+                    if ( ValParent .NE. Agrif_SpecialValue) then
+                        Res = Res + ValParent
+                        Nbvals = Nbvals + 1
+                    endif 
+                              enddo
+                        enddo
+                  enddo  
+               enddo
+C
+C
+            
+            if (Nbvals.GT.0) then
+              if (firsttest) then
+                   firsttest = .FALSE.
+                   i=1
+                   cycle
+              endif
+	      
+              tempP(indic(1),indic(2),indic(3),indic(4)) = Res/Nbvals
+	    
+              exit
+            else
+               if (firsttest) exit
+               i = i + 1                      
+            endif
+          enddo            
+C     
+      End Subroutine CalculNewValTempP4D        
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F	(revision 8201)
@@ -0,0 +1,1119 @@
+!
+! $Id: modmpp.F 2731 2011-04-08 12:05:35Z rblod $
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_mpp
+C
+      Module Agrif_mpp
+      Use Agrif_Types
+      Use Agrif_Arrays
+
+      Contains
+#ifdef key_mpp_mpi
+      Subroutine Get_External_Data_first(pttruetab,
+     &   cetruetab,pttruetabwhole,cetruetabwhole,nbdim,memberin,
+     &   memberout,memberoutall1,sendtoproc,recvfromproc,imin,imax,
+     &   imin_recv,imax_recv)
+
+      IMPLICIT NONE
+      INCLUDE 'mpif.h'
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: pttruetab,
+     &                                                 cetruetab
+      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: pttruetabwhole,
+     &                                                 cetruetabwhole
+      INTEGER :: k,i,k2
+      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc, recvfromproc
+      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1):: imin,imax,
+     &   imin_recv,imax_recv
+      LOGICAL :: memberin, memberout
+      INTEGER :: imintmp, imaxtmp,j,i1
+      INTEGER :: imin1,imax1
+      LOGICAL :: tochange,tochangebis
+      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: pttruetab2,
+     &                                                 cetruetab2
+      LOGICAL :: memberout1(1),memberoutall(0:Agrif_Nbprocs-1)
+      LOGICAL, OPTIONAL :: memberoutall1(0:Agrif_Nbprocs-1)
+      INTEGER :: code
+      
+C pttruetab2 and cetruetab2 are modified arraysin order to always
+C send the most inner points
+
+        
+        IF (present(memberoutall1)) THEN
+        memberoutall = memberoutall1
+        ELSE
+         memberout1(1) = memberout
+
+         CALL MPI_ALLGATHER(memberout1,1,MPI_LOGICAL,memberoutall,
+     &                  1,MPI_LOGICAL,MPI_COMM_AGRIF,code)
+        ENDIF
+         pttruetab2(:,Agrif_Procrank) = pttruetab(:,Agrif_Procrank)
+         cetruetab2(:,Agrif_Procrank) = cetruetab(:,Agrif_Procrank)
+         do k2=0,Agrif_Nbprocs-1
+            do i=1,nbdim
+
+           tochangebis=.TRUE.
+           DO i1=1,nbdim
+            IF (i .NE. i1) THEN
+              IF ((pttruetab(i1,Agrif_Procrank).NE.pttruetab(i1,k2)).OR.
+     &          (cetruetab(i1,Agrif_Procrank).NE.cetruetab(i1,k2))) THEN
+                   tochangebis = .FALSE.
+               EXIT
+              ENDIF
+             ENDIF
+           ENDDO
+
+           IF (tochangebis) THEN
+
+
+          imin1 = max(pttruetab(i,Agrif_Procrank),
+     &                    pttruetab(i,k2))
+          imax1 = min(cetruetab(i,Agrif_Procrank),
+     &                    cetruetab(i,k2))
+
+C Always send the most interior points
+
+           tochange = .false.
+           IF (cetruetab(i,Agrif_Procrank)> cetruetab(i,k2)) THEN
+
+           DO j=imin1,imax1
+             IF ((cetruetab(i,k2)-j) >
+     &             (j-pttruetab(i,Agrif_Procrank))) THEN
+             imintmp = j+1
+             tochange = .TRUE.
+             ELSE
+              EXIT
+             ENDIF
+          ENDDO
+          ENDIF
+
+           if (tochange) then
+C
+              pttruetab2(i,Agrif_Procrank) = imintmp
+C
+          endif
+
+           tochange = .FALSE.
+           imaxtmp=0
+           IF (pttruetab(i,Agrif_Procrank) < pttruetab(i,k2)) THEN
+          DO j=imax1,imin1,-1
+            IF ((j-pttruetab(i,k2)) >
+     &             (cetruetab(i,Agrif_Procrank)-j)) THEN
+             imaxtmp = j-1
+             tochange = .TRUE.
+            ELSE
+             EXIT
+            ENDIF
+          ENDDO
+
+          ENDIF
+
+                    if (tochange) then
+C
+              cetruetab2(i,Agrif_Procrank) = imaxtmp
+C
+          endif
+C
+
+          ENDIF
+           enddo
+         enddo
+
+
+       do k = 0,Agrif_NbProcs-1
+C
+        sendtoproc(k) = .true.
+C
+!CDIR SHORTLOOP
+        do i = 1,nbdim
+C
+          imin(i,k) = max(pttruetab2(i,Agrif_Procrank),
+     &                    pttruetabwhole(i,k))
+          imax(i,k) = min(cetruetab2(i,Agrif_Procrank),
+     &                    cetruetabwhole(i,k))
+C
+          if (imin(i,k) > imax(i,k)) then
+C
+              sendtoproc(k) = .false.
+C
+          endif
+C
+        enddo
+        IF (.NOT.memberoutall(k)) THEN
+           sendtoproc(k) = .FALSE.
+        ENDIF
+C
+      enddo
+      
+      Call Exchangesamelevel_first(sendtoproc,nbdim,imin,imax,
+     &     recvfromproc,imin_recv,imax_recv)
+      
+      End Subroutine Get_External_Data_first
+C
+      Subroutine Get_External_Data(tempC,tempCextend,pttruetab,
+     &   cetruetab,pttruetabwhole,cetruetabwhole,nbdim,memberin,
+     &   memberout,memberoutall1)
+
+      IMPLICIT NONE
+      INCLUDE 'mpif.h'
+      INTEGER :: nbdim
+      TYPE(Agrif_PVariable) :: tempC, tempCextend
+      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: pttruetab,
+     &                                                 cetruetab
+      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: pttruetabwhole,
+     &                                                 cetruetabwhole
+      INTEGER :: k,i,k2
+      LOGICAL :: sendtoproc(0:Agrif_Nbprocs-1)
+      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: imin,imax
+      LOGICAL :: memberin, memberout
+      INTEGER :: imintmp, imaxtmp,j,i1
+      INTEGER :: imin1,imax1
+      LOGICAL :: tochange,tochangebis
+      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: pttruetab2,
+     &                                                 cetruetab2
+      LOGICAL :: memberout1(1),memberoutall(0:Agrif_Nbprocs-1)
+      LOGICAL, OPTIONAL :: memberoutall1(0:Agrif_Nbprocs-1)
+      INTEGER :: code
+
+C pttruetab2 and cetruetab2 are modified arraysin order to always
+C send the most inner points
+
+        
+        IF (present(memberoutall1)) THEN
+        memberoutall = memberoutall1
+        ELSE
+         memberout1(1) = memberout
+
+         CALL MPI_ALLGATHER(memberout1,1,MPI_LOGICAL,memberoutall,
+     &                  1,MPI_LOGICAL,MPI_COMM_AGRIF,code)
+        ENDIF
+         pttruetab2(:,Agrif_Procrank) = pttruetab(:,Agrif_Procrank)
+         cetruetab2(:,Agrif_Procrank) = cetruetab(:,Agrif_Procrank)
+         do k2=0,Agrif_Nbprocs-1
+            do i=1,nbdim
+
+           tochangebis=.TRUE.
+           DO i1=1,nbdim
+            IF (i .NE. i1) THEN
+              IF ((pttruetab(i1,Agrif_Procrank).NE.pttruetab(i1,k2)).OR.
+     &          (cetruetab(i1,Agrif_Procrank).NE.cetruetab(i1,k2))) THEN
+                   tochangebis = .FALSE.
+               EXIT
+              ENDIF
+             ENDIF
+           ENDDO
+
+           IF (tochangebis) THEN
+
+
+          imin1 = max(pttruetab(i,Agrif_Procrank),
+     &                    pttruetab(i,k2))
+          imax1 = min(cetruetab(i,Agrif_Procrank),
+     &                    cetruetab(i,k2))
+
+C Always send the most interior points
+
+           tochange = .false.
+           IF (cetruetab(i,Agrif_Procrank)> cetruetab(i,k2)) THEN
+
+           DO j=imin1,imax1
+             IF ((cetruetab(i,k2)-j) >
+     &             (j-pttruetab(i,Agrif_Procrank))) THEN
+             imintmp = j+1
+             tochange = .TRUE.
+             ELSE
+              EXIT
+             ENDIF
+          ENDDO
+          ENDIF
+
+           if (tochange) then
+C
+              pttruetab2(i,Agrif_Procrank) = imintmp
+C
+          endif
+
+           tochange = .FALSE.
+           imaxtmp=0
+           IF (pttruetab(i,Agrif_Procrank) < pttruetab(i,k2)) THEN
+          DO j=imax1,imin1,-1
+            IF ((j-pttruetab(i,k2)) >
+     &             (cetruetab(i,Agrif_Procrank)-j)) THEN
+             imaxtmp = j-1
+             tochange = .TRUE.
+            ELSE
+             EXIT
+            ENDIF
+          ENDDO
+
+          ENDIF
+
+                    if (tochange) then
+C
+              cetruetab2(i,Agrif_Procrank) = imaxtmp
+C
+          endif
+C
+
+          ENDIF
+           enddo
+         enddo
+
+
+       do k = 0,Agrif_NbProcs-1
+C
+        sendtoproc(k) = .true.
+C
+!CDIR SHORTLOOP
+        do i = 1,nbdim
+C
+          imin(i,k) = max(pttruetab2(i,Agrif_Procrank),
+     &                    pttruetabwhole(i,k))
+          imax(i,k) = min(cetruetab2(i,Agrif_Procrank),
+     &                    cetruetabwhole(i,k))
+C
+          if (imin(i,k) > imax(i,k)) then
+C
+              sendtoproc(k) = .false.
+C
+          endif
+C
+        enddo
+        IF (.NOT.memberoutall(k)) THEN
+           sendtoproc(k) = .FALSE.
+        ENDIF
+C
+      enddo
+
+
+c       IF (.NOT.memberin) sendtoproc = .FALSE.
+
+      IF (memberout) THEN
+      Call Agrif_nbdim_allocation(tempCextend%var,
+     &                 pttruetabwhole(:,Agrif_ProcRank),
+     &                 cetruetabwhole(:,Agrif_ProcRank),nbdim)
+      call Agrif_nbdim_Full_VarEQreal(tempCextend%var,0.,nbdim)
+      ENDIF
+
+      IF (sendtoproc(Agrif_ProcRank)) THEN
+           Call Agrif_nbdim_VarEQvar(tempCextend%var,
+     &                               imin(:,Agrif_Procrank),
+     &                               imax(:,Agrif_Procrank),
+     &                               tempC%var,
+     &                               imin(:,Agrif_Procrank),
+     &                               imax(:,Agrif_Procrank),
+     &                               nbdim)
+      ENDIF
+
+      Call Exchangesamelevel(sendtoproc,nbdim,imin,imax,tempC,
+     &     tempCextend)
+
+      End Subroutine Get_External_Data
+
+       Subroutine ExchangeSameLevel(sendtoproc,nbdim,imin,imax,
+     &          tempC,tempCextend)
+      Implicit None
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin,imax
+      INTEGER,DIMENSION(nbdim,2,0:Agrif_Nbprocs-1) :: iminmax_temp
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin_recv,imax_recv
+      TYPE(Agrif_PVARIABLE) :: tempC,tempCextend
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1)       :: sendtoproc
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1)       :: recvfromproc
+      LOGICAL                                    :: res
+      TYPE(AGRIF_PVARIABLE), SAVE                      :: temprecv
+
+      INCLUDE 'mpif.h'
+          INTEGER :: i,k
+          INTEGER :: etiquette = 100
+          INTEGER :: code, datasize
+          INTEGER,DIMENSION(MPI_STATUS_SIZE)   :: statut
+
+
+      do k = 0,Agrif_ProcRank-1
+C
+C
+            Call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette,
+     &                    MPI_COMM_AGRIF,code)
+C
+            if (sendtoproc(k)) then
+C
+                iminmax_temp(:,1,k) = imin(:,k)
+                iminmax_temp(:,2,k) = imax(:,k)
+
+                Call MPI_SEND(iminmax_temp(:,:,k),
+     &                        2*nbdim,MPI_INTEGER,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+C
+                datasize = 1
+C
+!CDIR SHORTLOOP
+                do i = 1,nbdim
+C
+                  datasize = datasize * (imax(i,k)-imin(i,k)+1)
+C
+                enddo
+C
+                SELECT CASE(nbdim)
+                CASE(1)
+                   Call MPI_SEND(tempC%var%array1(
+     &                        imin(1,k):imax(1,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(2)
+                   Call MPI_SEND(tempC%var%array2(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(3)
+                
+                  Call Agrif_Send_3Darray(tempC%var%array3,
+     &             lbound(tempC%var%array3),imin(:,k),imax(:,k),k)
+                CASE(4)
+                   Call MPI_SEND(tempC%var%array4(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(5)
+                   Call MPI_SEND(tempC%var%array5(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(6)
+                   Call MPI_SEND(tempC%var%array6(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k),
+     &                        imin(6,k):imax(6,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                END SELECT
+C
+            endif
+
+C
+      enddo
+C
+C
+C     Reception from others processors of the necessary part of the parent grid
+      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
+C
+C
+            Call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette,
+     &                    MPI_COMM_AGRIF,statut,code)
+C
+            recvfromproc(k) = res
+
+C
+            if (recvfromproc(k)) then
+C
+                Call MPI_RECV(iminmax_temp(:,:,k),
+     &                        2*nbdim,MPI_INTEGER,k,etiquette,
+     &                        MPI_COMM_AGRIF,statut,code)
+
+                imin_recv(:,k) = iminmax_temp(:,1,k)
+                imax_recv(:,k) = iminmax_temp(:,2,k)
+
+                datasize = 1
+C
+!CDIR SHORTLOOP
+                do i = 1,nbdim
+C
+                datasize = datasize * (imax_recv(i,k)-imin_recv(i,k)+1)
+C
+                enddo
+
+             IF (.Not.Associated(temprecv%var)) allocate(temprecv%var)
+             call Agrif_nbdim_allocation(temprecv%var,imin_recv(:,k),
+     &   imax_recv(:,k),nbdim)
+            SELECT CASE(nbdim)
+            CASE(1)
+              Call MPI_RECV(temprecv%var%array1,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(2)
+              Call MPI_RECV(temprecv%var%array2,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(3)
+              Call MPI_RECV(temprecv%var%array3,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+
+            CASE(4)
+              Call MPI_RECV(temprecv%var%array4,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(5)
+              Call MPI_RECV(temprecv%var%array5,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(6)
+              Call MPI_RECV(temprecv%var%array6,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+       END SELECT
+                        
+            Call where_valtabtotab_mpi(tempCextend%var,
+     &             temprecv%var,imin_recv(:,k),imax_recv(:,k),0.,nbdim)
+     
+                Call Agrif_nbdim_deallocation(temprecv%var,nbdim)
+C                deallocate(temprecv%var)
+
+            endif
+
+C
+      enddo
+
+C     Reception from others processors of the necessary part of the parent grid
+      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
+C
+C
+            
+            Call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette,
+     &                    MPI_COMM_AGRIF,code)
+C
+            if (sendtoproc(k)) then
+C
+                iminmax_temp(:,1,k) = imin(:,k)
+                iminmax_temp(:,2,k) = imax(:,k)
+
+                Call MPI_SEND(iminmax_temp(:,:,k),
+     &                        2*nbdim,MPI_INTEGER,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+C
+                SELECT CASE(nbdim)
+                CASE(1)
+                datasize=SIZE(tempC%var%array1(
+     &                        imin(1,k):imax(1,k)))
+                   Call MPI_SEND(tempC%var%array1(
+     &                        imin(1,k):imax(1,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(2)
+                datasize=SIZE(tempC%var%array2(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k)))
+                   Call MPI_SEND(tempC%var%array2(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(3)
+                datasize=SIZE(tempC%var%array3(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k)))
+                   Call MPI_SEND(tempC%var%array3(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(4)
+                datasize=SIZE(tempC%var%array4(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k)))
+                   Call MPI_SEND(tempC%var%array4(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(5)
+                datasize=SIZE(tempC%var%array5(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k)))
+                   Call MPI_SEND(tempC%var%array5(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(6)
+                datasize=SIZE(tempC%var%array6(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k),
+     &                        imin(6,k):imax(6,k)))
+                   Call MPI_SEND(tempC%var%array6(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k),
+     &                        imin(6,k):imax(6,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                END SELECT
+C
+            endif
+
+C
+      enddo
+C
+C
+C     Reception from others processors of the necessary part of the parent grid
+      do k = Agrif_ProcRank-1,0,-1
+C
+C
+            Call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette,
+     &                    MPI_COMM_AGRIF,statut,code)
+C
+            recvfromproc(k) = res
+
+C
+            if (recvfromproc(k)) then
+C
+                Call MPI_RECV(iminmax_temp(:,:,k),
+     &                        2*nbdim,MPI_INTEGER,k,etiquette,
+     &                        MPI_COMM_AGRIF,statut,code)
+
+C                imin_recv(:,k) = iminmax_temp(:,1,k)
+C                imax_recv(:,k) = iminmax_temp(:,2,k)
+
+C                datasize = 1
+C
+C                do i = 1,nbdim
+C
+C                datasize = datasize * (imax_recv(i,k)-imin_recv(i,k)+1)
+C
+C                enddo
+             IF (.Not.Associated(temprecv%var)) allocate(temprecv%var)
+             call Agrif_nbdim_allocation(temprecv%var,
+     &   iminmax_temp(:,1,k),iminmax_temp(:,2,k),nbdim)
+            SELECT CASE(nbdim)
+            CASE(1)
+              datasize=SIZE(temprecv%var%array1)
+              Call MPI_RECV(temprecv%var%array1,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(2)
+              datasize=SIZE(temprecv%var%array2)
+              Call MPI_RECV(temprecv%var%array2,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(3)
+              datasize=SIZE(temprecv%var%array3)
+              Call MPI_RECV(temprecv%var%array3,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+
+            CASE(4)
+              datasize=SIZE(temprecv%var%array4)
+              Call MPI_RECV(temprecv%var%array4,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(5)
+              datasize=SIZE(temprecv%var%array5)
+              Call MPI_RECV(temprecv%var%array5,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(6)
+              datasize=SIZE(temprecv%var%array6)
+              Call MPI_RECV(temprecv%var%array6,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+          END SELECT
+            
+            Call where_valtabtotab_mpi(tempCextend%var,
+     &             temprecv%var,iminmax_temp(:,1,k),iminmax_temp(:,2,k)
+     &            ,0.,nbdim)
+     
+                Call Agrif_nbdim_deallocation(temprecv%var,nbdim)
+C                deallocate(temprecv%var)
+            endif
+
+C
+      enddo
+
+          End Subroutine ExchangeSamelevel
+          
+       Subroutine ExchangeSameLevel_first(sendtoproc,nbdim,imin,imax,
+     &          recvfromproc,imin_recv,imax_recv)
+      Implicit None
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin,imax
+      INTEGER,DIMENSION(nbdim,2,0:Agrif_Nbprocs-1) :: iminmax_temp
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin_recv,imax_recv
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1)       :: sendtoproc
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1)       :: recvfromproc
+      LOGICAL                                    :: res
+
+      INCLUDE 'mpif.h'
+          INTEGER :: i,k
+          INTEGER :: etiquette = 100
+          INTEGER :: code, datasize
+          INTEGER,DIMENSION(MPI_STATUS_SIZE)   :: statut
+
+     
+      do k = 0,Agrif_ProcRank-1
+C
+C
+            Call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette,
+     &                    MPI_COMM_AGRIF,code)
+C
+            if (sendtoproc(k)) then
+C
+                iminmax_temp(:,1,k) = imin(:,k)
+                iminmax_temp(:,2,k) = imax(:,k)
+
+                Call MPI_SEND(iminmax_temp(:,:,k),
+     &                        2*nbdim,MPI_INTEGER,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+C
+            endif
+
+C
+      enddo
+C
+C
+C     Reception from others processors of the necessary part of the parent grid
+      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
+C
+C
+            Call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette,
+     &                    MPI_COMM_AGRIF,statut,code)
+C
+            recvfromproc(k) = res
+
+C
+            if (recvfromproc(k)) then
+C
+                Call MPI_RECV(iminmax_temp(:,:,k),
+     &                        2*nbdim,MPI_INTEGER,k,etiquette,
+     &                        MPI_COMM_AGRIF,statut,code)
+
+                imin_recv(:,k) = iminmax_temp(:,1,k)
+                imax_recv(:,k) = iminmax_temp(:,2,k)
+            endif
+
+C
+      enddo
+
+C     Reception from others processors of the necessary part of the parent grid
+      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
+C
+C
+            
+            Call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette,
+     &                    MPI_COMM_AGRIF,code)
+C
+            if (sendtoproc(k)) then
+C
+                iminmax_temp(:,1,k) = imin(:,k)
+                iminmax_temp(:,2,k) = imax(:,k)
+
+                Call MPI_SEND(iminmax_temp(:,:,k),
+     &                        2*nbdim,MPI_INTEGER,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+C
+            endif
+
+C
+      enddo
+C
+C
+C     Reception from others processors of the necessary part of the parent grid
+      do k = Agrif_ProcRank-1,0,-1
+C
+C
+            Call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette,
+     &                    MPI_COMM_AGRIF,statut,code)
+C
+            recvfromproc(k) = res
+
+C
+            if (recvfromproc(k)) then
+C
+                Call MPI_RECV(iminmax_temp(:,:,k),
+     &                        2*nbdim,MPI_INTEGER,k,etiquette,
+     &                        MPI_COMM_AGRIF,statut,code)
+
+                imin_recv(:,k) = iminmax_temp(:,1,k)
+                imax_recv(:,k) = iminmax_temp(:,2,k)
+            endif
+
+C
+      enddo
+
+          End Subroutine ExchangeSamelevel_first          
+
+       Subroutine ExchangeSameLevel2(sendtoproc,recvfromproc,
+     &   nbdim,
+     &          pttruetabwhole,cetruetabwhole,imin,imax,
+     &          imin_recv,imax_recv,memberout,tempC,tempCextend)
+      Implicit None
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin,imax
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: pttruetabwhole,
+     &     cetruetabwhole
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin_recv,imax_recv
+      TYPE(Agrif_PVARIABLE) :: tempC,tempCextend
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1)       :: sendtoproc
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1)       :: recvfromproc
+      LOGICAL                                    :: res
+      LOGICAL :: memberout
+      TYPE(AGRIF_PVARIABLE), SAVE                      :: temprecv
+
+      INCLUDE 'mpif.h'
+          INTEGER :: i,k
+          INTEGER :: etiquette = 100
+          INTEGER :: code, datasize
+          INTEGER,DIMENSION(MPI_STATUS_SIZE)   :: statut
+
+      IF (memberout) THEN
+      Call Agrif_nbdim_allocation(tempCextend%var,
+     &                 pttruetabwhole(:,Agrif_ProcRank),
+     &                 cetruetabwhole(:,Agrif_ProcRank),nbdim)
+      call Agrif_nbdim_Full_VarEQreal(tempCextend%var,0.,nbdim)
+      ENDIF
+
+      IF (sendtoproc(Agrif_ProcRank)) THEN
+           Call Agrif_nbdim_VarEQvar(tempCextend%var,
+     &                               imin(:,Agrif_Procrank),
+     &                               imax(:,Agrif_Procrank),
+     &                               tempC%var,
+     &                               imin(:,Agrif_Procrank),
+     &                               imax(:,Agrif_Procrank),
+     &                               nbdim)
+      ENDIF
+
+      do k = 0,Agrif_ProcRank-1
+C
+C
+C
+            if (sendtoproc(k)) then
+C
+                datasize = 1
+C
+!CDIR SHORTLOOP
+                do i = 1,nbdim
+C
+                  datasize = datasize * (imax(i,k)-imin(i,k)+1)
+C
+                enddo
+C
+
+                SELECT CASE(nbdim)
+                CASE(1)
+                   Call MPI_SEND(tempC%var%array1(
+     &                        imin(1,k):imax(1,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(2)               
+                   Call MPI_SEND(tempC%var%array2(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(3)
+     
+                  Call Agrif_Send_3Darray(tempC%var%array3,
+     &             lbound(tempC%var%array3),imin(:,k),imax(:,k),k)
+                CASE(4)
+                   Call MPI_SEND(tempC%var%array4(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(5)
+                   Call MPI_SEND(tempC%var%array5(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(6)
+                   Call MPI_SEND(tempC%var%array6(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k),
+     &                        imin(6,k):imax(6,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                END SELECT
+C
+            endif
+
+C
+      enddo
+C
+C
+C     Reception from others processors of the necessary part of the parent grid
+      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
+
+C
+            if (recvfromproc(k)) then
+
+                datasize = 1
+C
+!CDIR SHORTLOOP
+                do i = 1,nbdim
+C
+                datasize = datasize * (imax_recv(i,k)-imin_recv(i,k)+1)
+C
+                enddo
+
+             IF (.Not.Associated(temprecv%var)) allocate(temprecv%var)
+             call Agrif_nbdim_allocation(temprecv%var,imin_recv(:,k),
+     &   imax_recv(:,k),nbdim)
+            SELECT CASE(nbdim)
+            CASE(1)
+              Call MPI_RECV(temprecv%var%array1,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(2)           
+              Call MPI_RECV(temprecv%var%array2,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(3)       
+              Call MPI_RECV(temprecv%var%array3,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+
+            CASE(4)
+              Call MPI_RECV(temprecv%var%array4,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(5)
+              Call MPI_RECV(temprecv%var%array5,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(6)
+              Call MPI_RECV(temprecv%var%array6,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+       END SELECT
+                        
+            Call where_valtabtotab_mpi(tempCextend%var,
+     &             temprecv%var,imin_recv(:,k),imax_recv(:,k),0.,nbdim)
+     
+                Call Agrif_nbdim_deallocation(temprecv%var,nbdim)
+C                deallocate(temprecv%var)
+
+            endif
+
+C
+      enddo
+
+C     Reception from others processors of the necessary part of the parent grid
+      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
+C
+C
+            if (sendtoproc(k)) then
+C
+                SELECT CASE(nbdim)
+                CASE(1)
+                datasize=SIZE(tempC%var%array1(
+     &                        imin(1,k):imax(1,k)))
+                   Call MPI_SEND(tempC%var%array1(
+     &                        imin(1,k):imax(1,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(2)                
+                datasize=SIZE(tempC%var%array2(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k)))
+                   Call MPI_SEND(tempC%var%array2(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(3)
+                datasize=SIZE(tempC%var%array3(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k)))
+                   Call MPI_SEND(tempC%var%array3(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(4)
+                datasize=SIZE(tempC%var%array4(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k)))
+                   Call MPI_SEND(tempC%var%array4(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(5)
+                datasize=SIZE(tempC%var%array5(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k)))
+                   Call MPI_SEND(tempC%var%array5(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(6)
+                datasize=SIZE(tempC%var%array6(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k),
+     &                        imin(6,k):imax(6,k)))
+                   Call MPI_SEND(tempC%var%array6(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k),
+     &                        imin(6,k):imax(6,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                END SELECT
+C
+            endif
+
+C
+      enddo
+C
+C
+C     Reception from others processors of the necessary part of the parent grid
+      do k = Agrif_ProcRank-1,0,-1
+C
+
+C
+            if (recvfromproc(k)) then
+C
+             IF (.Not.Associated(temprecv%var)) allocate(temprecv%var)
+             call Agrif_nbdim_allocation(temprecv%var,
+     &   imin_recv(:,k),imax_recv(:,k),nbdim)
+            SELECT CASE(nbdim)
+            CASE(1)
+              datasize=SIZE(temprecv%var%array1)
+              Call MPI_RECV(temprecv%var%array1,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(2)           
+              datasize=SIZE(temprecv%var%array2)
+              Call MPI_RECV(temprecv%var%array2,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(3)           
+              datasize=SIZE(temprecv%var%array3)
+              Call MPI_RECV(temprecv%var%array3,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+
+            CASE(4)
+              datasize=SIZE(temprecv%var%array4)
+              Call MPI_RECV(temprecv%var%array4,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(5)
+              datasize=SIZE(temprecv%var%array5)
+              Call MPI_RECV(temprecv%var%array5,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(6)
+              datasize=SIZE(temprecv%var%array6)
+              Call MPI_RECV(temprecv%var%array6,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+          END SELECT
+            
+            Call where_valtabtotab_mpi(tempCextend%var,
+     &             temprecv%var,imin_recv(:,k),imax_recv(:,k)
+     &            ,0.,nbdim)
+     
+                Call Agrif_nbdim_deallocation(temprecv%var,nbdim)
+C                deallocate(temprecv%var)
+            endif
+
+C
+      enddo
+                  
+          End Subroutine ExchangeSamelevel2
+          
+          Subroutine Agrif_Send_3Darray(tab3D,bounds,imin,imax,k)
+          integer, dimension(3) :: bounds, imin, imax
+          real,dimension(bounds(1):,bounds(2):,bounds(3):),target
+     &                             :: tab3D
+          integer :: k
+          integer :: etiquette = 100
+          integer :: datasize, code
+        INCLUDE 'mpif.h'
+
+          datasize = SIZE(tab3D(
+     &                       imin(1):imax(1),
+     &                        imin(2):imax(2),
+     &                        imin(3):imax(3)))
+       
+                   Call MPI_SEND(tab3D(
+     &                        imin(1):imax(1),
+     &                        imin(2):imax(2),
+     &                        imin(3):imax(3)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+     
+         End Subroutine Agrif_Send_3Darray
+
+#else
+      Subroutine Agrif_mpp_empty()
+      End Subroutine Agrif_mpp_empty
+#endif
+
+      End Module Agrif_mpp
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F	(revision 8201)
@@ -0,0 +1,937 @@
+!
+! $Id: modsauv.F 2715 2011-03-30 15:58:35Z rblod $
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_Save  
+C
+      Module Agrif_Save 
+C
+CCC   Description:   
+CCC   Module for the initialization by copy of the grids created by clustering.
+C
+C     Modules used:
+C      
+      Use Agrif_Types
+      Use Agrif_Link
+      Use Agrif_Arrays
+      Use Agrif_Variables
+C
+      IMPLICIT NONE
+C
+      Contains
+C     Definition of procedures contained in this module.
+C
+C
+      Subroutine Agrif_Deallocate_Arrays(Var)
+      type(Agrif_Variable), pointer :: Var
+      
+            if (ALLOCATED(var%array1)) then
+               Deallocate(var%array1)
+            endif
+            if (ALLOCATED(var%array2)) then
+               Deallocate(var%array2)
+            endif
+            if (ALLOCATED(var%array3)) then
+               Deallocate(var%array3)
+            endif
+            if (ALLOCATED(var%array4)) then
+               Deallocate(var%array4)
+            endif
+            if (ALLOCATED(var%array5)) then
+               Deallocate(var%array5)
+            endif
+            if (ALLOCATED(var%array6)) then
+               Deallocate(var%array6)
+            endif
+C
+            if (ALLOCATED(var%darray1)) then
+               Deallocate(var%darray1)
+            endif
+            if (ALLOCATED(var%darray2)) then
+               Deallocate(var%darray2)
+            endif
+            if (ALLOCATED(var%darray3)) then
+               Deallocate(var%darray3)
+            endif
+            if (ALLOCATED(var%darray4)) then
+               Deallocate(var%darray4)
+            endif
+            if (ALLOCATED(var%darray5)) then
+               Deallocate(var%darray5)
+            endif
+            if (ALLOCATED(var%darray6)) then
+               Deallocate(var%darray6)
+            endif
+C
+            if (ALLOCATED(var%larray1)) then
+               Deallocate(var%larray1)
+            endif
+            if (ALLOCATED(var%larray2)) then
+               Deallocate(var%larray2)
+            endif
+            if (ALLOCATED(var%larray3)) then
+               Deallocate(var%larray3)
+            endif
+            if (ALLOCATED(var%larray4)) then
+               Deallocate(var%larray4)
+            endif
+            if (ALLOCATED(var%larray5)) then
+               Deallocate(var%larray5)
+            endif
+            if (ALLOCATED(var%larray6)) then
+               Deallocate(var%larray6)
+            endif
+C
+            if (ALLOCATED(var%iarray1)) then
+               Deallocate(var%iarray1)
+            endif
+            if (ALLOCATED(var%iarray2)) then
+               Deallocate(var%iarray2)
+            endif
+            if (ALLOCATED(var%iarray3)) then
+               Deallocate(var%iarray3)
+            endif
+            if (ALLOCATED(var%iarray4)) then
+               Deallocate(var%iarray4)
+            endif
+            if (ALLOCATED(var%iarray5)) then
+               Deallocate(var%iarray5)
+            endif
+            if (ALLOCATED(var%iarray6)) then
+               Deallocate(var%iarray6)
+            endif
+C
+            if (ALLOCATED(var%carray1)) then
+               Deallocate(var%carray1)
+            endif
+            if (ALLOCATED(var%carray2)) then
+               Deallocate(var%carray2)
+            endif
+C
+            if (associated(var%oldvalues2D)) then
+               Deallocate(var%oldvalues2D)
+            endif
+            if (associated(var%interpIndex)) then
+               Deallocate(var%interpIndex)
+            endif
+            
+            if (associated(var%posvar)) then
+               Deallocate(var%posvar)
+            endif     
+            
+            if (associated(var%interptab)) then
+               Deallocate(var%interptab)
+            endif
+            
+      Return
+      End Subroutine Agrif_Deallocate_Arrays    
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Free_data_before
+C     **************************************************************************
+C
+      Subroutine Agrif_Free_data_before(Agrif_Gr)
+C
+CCC   Description:
+CCC   
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+      
+C      
+C     Pointer argument    
+      TYPE(Agrif_Grid),pointer   :: Agrif_Gr ! Pointer on the current grid
+      INTEGER i 
+      Type(Agrif_List_Variables), pointer :: parcours      
+C
+C   
+      do i = 1 , AGRIF_NbVariables
+         if ( .NOT. Agrif_Mygrid % tabvars(i) % var % restaure) then
+C 
+            call Agrif_Deallocate_Arrays(Agrif_Gr%tabvars(i)%var)
+            
+       endif
+           
+C
+       if (associated(Agrif_Gr%tabvars(i)%var%list_interp)) then
+         Call Agrif_Free_list_interp
+     &                          (Agrif_Gr%tabvars(i)%var%list_interp)
+       endif                             
+C
+       if ( .NOT. Agrif_Mygrid % tabvars(i) % var % restaure) then
+            Deallocate(Agrif_Gr%tabvars(i)%var)
+C 
+        endif
+      enddo
+      
+      parcours => Agrif_Gr%variables
+    
+      do i=1,Agrif_Gr%NbVariables
+       if (.NOT. parcours%pvar%var%root_var%restaure) then
+        call Agrif_Deallocate_Arrays(parcours%pvar%var)
+       endif
+        if (associated(parcours%pvar%var%list_interp)) then
+           Call Agrif_Free_list_interp
+     &                          (parcours%pvar%var%list_interp)
+         endif                             
+C
+       if ( .NOT. parcours%pvar%var%root_var % restaure) then
+            Deallocate(parcours%pvar%var)
+C 
+        endif
+        parcours => parcours%nextvariable
+      enddo
+C
+C 
+C
+      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
+         if ( Agrif_Probdim .EQ. 1 ) Deallocate(Agrif_Gr%tabpoint1D)
+         if ( Agrif_Probdim .EQ. 2 ) Deallocate(Agrif_Gr%tabpoint2D)
+         if ( Agrif_Probdim .EQ. 3 ) Deallocate(Agrif_Gr%tabpoint3D)
+      endif
+C          
+      Return
+C
+C
+      End Subroutine Agrif_Free_data_before
+C
+C
+      Recursive Subroutine Agrif_Free_list_interp(list_interp)
+      TYPE(Agrif_List_Interp_Loc), Pointer :: list_interp
+      
+      if (associated(list_interp%suiv))
+     &      Call Agrif_Free_list_interp(list_interp%suiv)
+     
+#ifdef key_mpp_mpi
+       Deallocate(list_interp%interp_loc%tab4t)
+       Deallocate(list_interp%interp_loc%memberinall)
+       Deallocate(list_interp%interp_loc%sendtoproc1)
+       Deallocate(list_interp%interp_loc%recvfromproc1)
+#endif
+       Deallocate(list_interp%interp_loc)
+       Deallocate(list_interp)
+       Nullify(list_interp)
+
+      End Subroutine Agrif_Free_list_interp      
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Free_data_after
+C     **************************************************************************
+C      
+      Subroutine Agrif_Free_data_after(Agrif_Gr)
+C
+CCC   Description:
+CCC   
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+C
+      
+C
+C     Pointer argument    
+      TYPE(Agrif_Grid),pointer   :: Agrif_Gr  ! Pointer on the current grid
+      INTEGER i
+      Type(Agrif_List_Variables), pointer :: parcours, rootparcours
+C
+C      
+      do i = 1 , AGRIF_NbVariables
+         if ( Agrif_Mygrid % tabvars(i) % var % restaure) then
+            
+         call Agrif_Deallocate_Arrays(Agrif_Gr%tabvars(i)%var)
+         !
+            Deallocate(Agrif_Gr%tabvars(i)%var)
+! 
+         endif
+      enddo
+      
+      parcours => Agrif_Gr%variables
+      rootparcours=>Agrif_Mygrid%variables
+    
+      do i=1,Agrif_Gr%NbVariables
+       if (rootparcours%pvar%var%restaure) then
+        call Agrif_Deallocate_Arrays(parcours%pvar%var)
+      
+            Deallocate(parcours%pvar%var)
+C 
+        endif
+        parcours => parcours%nextvariable
+        rootparcours => rootparcours%nextvariable        
+      enddo
+            
+C
+C      
+      Return
+C
+C
+      End Subroutine Agrif_Free_data_after      
+C
+C
+CC    **************************************************************************
+CCC   Subroutine AGRIF_CopyFromold_All
+C     **************************************************************************
+C
+      Recursive Subroutine AGRIF_CopyFromold_All(g,oldchildgrids)
+C
+CCC   Description:
+CCC   Routine called in the Agrif_Init_Hierarchy procedure 
+C       (Agrif_Clustering module). 
+C
+CC    Method:        
+C
+C     Declarations:
+C
+      
+C      
+C     Pointer argument    
+      TYPE(AGRIF_grid),pointer   :: g ! Pointer on the current grid
+      TYPE(AGRIF_pgrid),pointer   :: oldchildgrids
+C
+C     Local pointer
+      TYPE(AGRIF_pgrid),pointer  :: parcours ! Pointer for the recursive 
+                                             ! procedure 
+      REAL g_eps,eps,oldgrid_eps
+      INTEGER :: out
+      INTEGER :: iii
+C
+      out = 0
+C                                                                           
+      parcours => oldchildgrids  
+C
+      do while (associated(parcours))
+C 
+        if ((.NOT. g % fixed) .AND. (parcours % gr %oldgrid)) then
+C        
+            g_eps = huge(1.)
+            oldgrid_eps = huge(1.)
+            do iii = 1 , Agrif_Probdim
+               g_eps = min(g_eps,g % Agrif_d(iii))
+               oldgrid_eps = min(oldgrid_eps,
+     &                       parcours % gr % Agrif_d(iii))
+            enddo
+C
+            eps = min(g_eps,oldgrid_eps)/100.                  
+C
+            do iii = 1 , Agrif_Probdim
+
+               if (g % Agrif_d(iii) .LT. 
+     &             (parcours % gr % Agrif_d(iii) - eps)) then
+C            
+                   parcours => parcours % next
+C            
+                   out = 1
+C   
+                   Exit
+C             
+               endif
+C      
+            enddo
+        if ( out .EQ. 1 ) Cycle
+C
+            Call AGRIF_CopyFromOld(g,parcours%gr)
+C
+        endif
+C                     
+        Call Agrif_CopyFromold_All
+     &             (g, parcours % gr % child_grids)
+C        
+        parcours => parcours % next
+C        
+      enddo
+C
+C     
+      Return      
+C
+C
+      End Subroutine AGRIF_CopyFromold_All
+C
+C
+C      
+C     **************************************************************************
+CCC   Subroutine Agrif_CopyFromold
+C     **************************************************************************
+C      
+      Subroutine Agrif_CopyFromold(Agrif_New_Gr,Agrif_Old_Gr)
+C
+CCC   Description:
+CCC   Call to the Agrif_Copy procedure.
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+      
+C      
+C     Pointer argument    
+      TYPE(Agrif_Grid),Pointer   :: Agrif_New_Gr  ! Pointer on the current grid
+      TYPE(Agrif_Grid),Pointer :: Agrif_Old_Gr    ! Pointer on an old grid
+      INTEGER :: i
+C
+C      
+      do i = 1 , AGRIF_NbVariables
+         if ( Agrif_Mygrid % tabvars(i) % var % restaure ) then
+C
+            Call Agrif_Copy(Agrif_New_Gr,Agrif_Old_Gr,
+     &           Agrif_New_Gr % tabvars(i),
+     &           Agrif_Old_Gr % tabvars(i))
+C
+        endif
+      enddo
+
+C      
+C            
+      Return
+C
+C      
+      End Subroutine Agrif_CopyFromold
+      
+CC    **************************************************************************
+CCC   Subroutine AGRIF_CopyFromold_AllOneVar
+C     **************************************************************************
+C
+      Recursive Subroutine AGRIF_CopyFromold_AllOneVar(g,oldchildgrids,
+     &   indic)
+C
+CCC   Description:
+CCC   Routine called in the Agrif_Init_Hierarchy procedure 
+C       (Agrif_Clustering module). 
+C
+CC    Method:        
+C
+C     Declarations:
+C
+      
+C      
+C     Pointer argument    
+      TYPE(AGRIF_grid),pointer   :: g ! Pointer on the current grid
+      TYPE(AGRIF_pgrid),pointer   :: oldchildgrids
+      integer :: indic
+C
+C     Local pointer
+      TYPE(AGRIF_pgrid),pointer  :: parcours ! Pointer for the recursive 
+                                             ! procedure 
+      REAL g_eps,eps,oldgrid_eps
+      INTEGER :: out
+      INTEGER :: iii
+C
+      out = 0
+C                                                                           
+      parcours => oldchildgrids  
+C
+      do while (associated(parcours))
+C 
+        if ((.NOT. g % fixed) .AND. (parcours % gr %oldgrid)) then
+C        
+            g_eps = huge(1.)
+            oldgrid_eps = huge(1.)
+            do iii = 1 , Agrif_Probdim
+               g_eps = min(g_eps,g % Agrif_d(iii))
+               oldgrid_eps = min(oldgrid_eps,
+     &                       parcours % gr % Agrif_d(iii))
+            enddo
+C
+            eps = min(g_eps,oldgrid_eps)/100.                  
+C
+            do iii = 1 , Agrif_Probdim
+
+               if (g % Agrif_d(iii) .LT. 
+     &             (parcours % gr % Agrif_d(iii) - eps)) then
+C            
+                   parcours => parcours % next
+C            
+                   out = 1
+C   
+                   Exit
+C             
+               endif
+C      
+            enddo
+        if ( out .EQ. 1 ) Cycle
+C
+            Call AGRIF_CopyFromOldOneVar(g,parcours%gr,indic)
+C
+        endif
+C                     
+        Call Agrif_CopyFromold_AllOneVar
+     &             (g, parcours % gr % child_grids,indic)
+C        
+        parcours => parcours % next
+C        
+      enddo
+C
+C     
+      Return      
+C
+C
+      End Subroutine AGRIF_CopyFromold_AllOneVar
+C
+C
+C      
+C     **************************************************************************
+CCC   Subroutine Agrif_CopyFromoldOneVar
+C     **************************************************************************
+C      
+      Subroutine Agrif_CopyFromoldOneVar(Agrif_New_Gr,Agrif_Old_Gr,
+     &    indic)
+C
+CCC   Description:
+CCC   Call to the Agrif_Copy procedure.
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+      
+C      
+C     Pointer argument    
+      TYPE(Agrif_Grid),Pointer   :: Agrif_New_Gr  ! Pointer on the current grid
+      TYPE(Agrif_Grid),Pointer :: Agrif_Old_Gr    ! Pointer on an old grid
+      INTEGER :: indic
+      INTEGER :: i
+      TYPE(Agrif_PVariable),Pointer ::tabvars,oldtabvars      
+C
+C      
+      tabvars => Agrif_Search_Variable(Agrif_New_Gr,-indic)
+      oldtabvars => Agrif_Search_Variable(Agrif_Old_Gr,-indic)
+
+      Call Agrif_Nbdim_Allocation(tabvars%var,
+     &  tabvars%var%lb,tabvars%var%ub,
+     &  tabvars%var%nbdim)
+     
+      Call Agrif_Copy(Agrif_New_Gr,Agrif_Old_Gr,
+     &           tabvars,oldtabvars)
+
+
+C      
+C            
+      Return
+C
+C      
+      End Subroutine Agrif_CopyFromoldOneVar      
+      
+C
+C
+CC
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Copy
+C     **************************************************************************
+C      
+      Subroutine Agrif_Copy(Agrif_New_Gr,Agrif_Old_Gr,New_Var,Old_Var)
+C     
+CCC   Description:
+CCC   Sets arguments of the Agrif_UpdatenD procedures, n being the number of 
+CCC   DIMENSION of the grid variable.
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+      
+C
+C     Pointer argument    
+      TYPE(Agrif_Grid),Pointer   :: Agrif_New_Gr   ! Pointer on the current grid
+      TYPE(Agrif_Grid), Pointer :: Agrif_Old_Gr    ! Pointer on an old grid
+      TYPE(Agrif_Pvariable) :: New_Var, Old_Var
+      INTEGER :: nbdim                  ! Number of dimensions of the current 
+                                        ! grid      
+      INTEGER,DIMENSION(6) :: pttabnew  ! Indexes of the first point in the 
+                                        ! domain
+      INTEGER,DIMENSION(6) :: petabnew  ! Indexes of the first point in the 
+                                        ! domain
+      INTEGER,DIMENSION(6) :: pttabold  ! Indexes of the first point in the 
+                                        ! domain
+      INTEGER,DIMENSION(6) :: petabold  ! Indexes of the first point in the 
+                                        ! domain
+      INTEGER,DIMENSION(6) :: nbtabold  ! Number of cells in each direction
+      
+      INTEGER,DIMENSION(6) :: nbtabnew  ! Number of cells in each direction   
+      TYPE(AGRIF_Variable), Pointer :: root ! Pointer on the variable of the 
+                                            ! root grid
+      REAL, DIMENSION(6) :: snew,sold
+      REAL, DIMENSION(6) :: dsnew,dsold                              
+      REAL :: eps
+      INTEGER :: n
+C
+C  
+      root => New_Var % var % root_var 
+C      
+      nbdim = root % nbdim
+C         
+      do n=1,nbdim
+C  
+        select case(root % interptab(n))
+C        
+        case('x')                
+C
+          pttabnew(n) = root % point(1)
+C        
+          pttabold(n) = root % point(1)
+C        
+          snew(n) = Agrif_New_Gr % Agrif_x(1)
+C
+          sold(n) = Agrif_Old_Gr % Agrif_x(1) 
+C        
+          dsnew(n) = Agrif_New_Gr % Agrif_d(1)
+C
+          dsold(n) = Agrif_Old_Gr % Agrif_d(1)
+C                      
+          if (root % posvar(n) .EQ. 1) then
+C          
+              petabnew(n) = pttabnew(n) + Agrif_New_Gr % nb(1)
+C          
+              petabold(n) = pttabold(n) + Agrif_Old_Gr % nb(1)         
+C        
+            else
+C          
+              petabnew(n) = pttabnew(n) + Agrif_New_Gr % nb(1) - 1
+C          
+              petabold(n) = pttabold(n) + Agrif_Old_Gr % nb(1) - 1
+C
+              snew(n) = snew(n) + dsnew(n)/2.
+C
+              sold(n) = sold(n) + dsold(n)/2.
+C        
+          endif           
+C        
+        case('y')
+C        
+          pttabnew(n) = root % point(2)
+C        
+          pttabold(n) = root % point(2)
+C        
+          snew(n) = Agrif_New_Gr % Agrif_x(2)
+C        
+          sold(n) = Agrif_Old_Gr % Agrif_x(2)
+C        
+          dsnew(n) = Agrif_New_Gr % Agrif_d(2)
+C        
+          dsold(n) = Agrif_Old_Gr % Agrif_d(2)
+C                
+          if (root % posvar(n) .EQ. 1) then
+C        
+              petabnew(n) = pttabnew(n) + Agrif_New_Gr % nb(2)
+C          
+              petabold(n) = pttabold(n) + Agrif_Old_Gr % nb(2)         
+C        
+            else
+C          
+              petabnew(n) = pttabnew(n) + Agrif_New_Gr % nb(2) - 1
+C          
+              petabold(n) = pttabold(n) + Agrif_Old_Gr % nb(2) - 1
+C
+              snew(n) = snew(n) + dsnew(n)/2.
+C
+              sold(n) = sold(n) + dsold(n)/2.                    
+C        
+          endif 
+C        
+        case('z')
+C        
+          pttabnew(n) = root % point(3)
+C        
+          pttabold(n) = root % point(3)
+C        
+          snew(n) = Agrif_New_Gr % Agrif_x(3)
+C        
+          sold(n) = Agrif_Old_Gr % Agrif_x(3)
+C        
+          dsnew(n) = Agrif_New_Gr % Agrif_d(3)
+C        
+          dsold(n) = Agrif_Old_Gr % Agrif_d(3)
+C                
+          if (root % posvar(n) .EQ. 1) then
+C        
+              petabnew(n) = pttabnew(n) + Agrif_New_Gr % nb(3)
+C          
+              petabold(n) = pttabold(n) + Agrif_Old_Gr % nb(3)         
+C        
+            else
+C          
+             petabnew(n) = pttabnew(n) + Agrif_New_Gr % nb(3) - 1
+C          
+             petabold(n) = pttabold(n) + Agrif_Old_Gr % nb(3) - 1
+C
+             snew(n) = snew(n) + dsnew(n)/2.
+C
+             sold(n) = sold(n) + dsold(n)/2.                   
+C        
+          endif
+C          
+        case('N')
+C        
+          Call Agrif_nbdim_Get_bound(New_Var%var,
+     &                           pttabnew(n),petabnew(n),
+     &                           n,nbdim)
+C        
+          pttabold(n) = pttabnew(n)
+C      
+          petabold(n) = petabnew(n)
+C              
+          snew(n) = 0.
+C      
+          sold(n) = 0. 
+C      
+          dsnew(n) = 1.
+C      
+          dsold(n) = 1.
+C        
+        end select
+C      
+      enddo
+C      
+      do n = 1,nbdim
+C      
+        nbtabnew(n) = petabnew(n) - pttabnew(n)
+C      
+        nbtabold(n) = petabold(n) - pttabold(n)      
+C 
+      enddo      
+C
+      eps = min(minval(dsnew(1:nbdim)),minval(dsold(1:nbdim)))
+C     
+      eps = eps/100.      
+C      
+      do n = 1,nbdim
+C      
+        if (snew(n) .GT. (sold(n)+dsold(n)*nbtabold(n)+eps)) Return
+C      
+        if ((snew(n)+dsnew(n)*nbtabnew(n)-eps) .LT. sold(n)) Return
+C      
+      enddo
+C            
+C
+      Call AGRIF_CopynD
+     &        (New_Var,Old_Var,pttabold,petabold,pttabnew,petabnew,
+     &         sold,snew,dsold,dsnew,nbdim) 
+C      
+C 
+      Return
+C      
+C
+      End Subroutine Agrif_Copy
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_CopynD
+C     **************************************************************************
+C      
+      Subroutine Agrif_CopynD(New_Var,Old_Var,pttabold,petabold,
+     &                        pttabnew,petabnew,sold,snew,dsold,
+     &                        dsnew,nbdim)
+C     
+CCC   Description:
+CCC   Copy of the nD New_Var variable from the nD Old_Var variable.
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+      
+C
+      INTEGER :: nbdim
+      TYPE(Agrif_Pvariable) :: New_Var, Old_Var     
+      INTEGER,DIMENSION(nbdim) :: pttabnew 
+      INTEGER,DIMENSION(nbdim) :: petabnew
+      INTEGER,DIMENSION(nbdim) :: pttabold
+      INTEGER,DIMENSION(nbdim) :: petabold      
+      REAL, DIMENSION(nbdim) :: snew,sold
+      REAL, DIMENSION(nbdim) :: dsnew,dsold 
+C
+      INTEGER :: i,j,k,l,m,n,i0,j0,k0,l0,m0,n0
+C
+      REAL, DIMENSION(nbdim) :: dim_gmin,dim_gmax
+      REAL, DIMENSION(nbdim) :: dim_newmin,dim_newmax
+      REAL, DIMENSION(nbdim) :: dim_min
+      INTEGER, DIMENSION(nbdim) :: ind_gmin,ind_newmin
+      INTEGER, DIMENSION(nbdim) ::  ind_newmax
+C               
+C
+      do i = 1,nbdim
+C      
+        dim_gmin(i) = sold(i)
+        dim_gmax(i) = sold(i) + (petabold(i)-pttabold(i)) * dsold(i)
+C 
+        dim_newmin(i) = snew(i)
+        dim_newmax(i) = snew(i) + (petabnew(i)-pttabnew(i)) * dsnew(i)
+C
+      enddo         
+C
+      do i = 1,nbdim
+C  
+        if (dim_gmax(i) .LT. dim_newmin(i)) Return
+C      
+        if (dim_gmin(i) .GT. dim_newmax(i)) Return
+C
+      enddo
+C
+C
+      do i = 1,nbdim
+C 
+        ind_newmin(i) = pttabnew(i) - floor(-(max(dim_gmin(i),
+     &                      dim_newmin(i))-dim_newmin(i))/dsnew(i)) 
+C      
+        dim_min(i) = snew(i) + (ind_newmin(i)-pttabnew(i))*dsnew(i)
+C      
+        ind_gmin(i) = pttabold(i) + nint((dim_min(i)-
+     &                dim_gmin(i))/dsold(i))      
+C
+        ind_newmax(i) = pttabnew(i) 
+     &                  + int((min(dim_gmax(i),dim_newmax(i))
+     &                         -dim_newmin(i))/dsnew(i))
+C
+      enddo 
+C
+C
+C
+      SELECT CASE (nbdim)
+      CASE (1)
+         i0 = ind_gmin(1)
+         do i = ind_newmin(1),ind_newmax(1)
+            New_Var % var % array1(i) =
+     &      Old_Var % var % array1(i0)
+            New_Var % var % restore1D(i) = 1   
+         i0 = i0 + int(dsnew(1)/dsold(1))
+         enddo
+      CASE (2)
+
+        i0 = ind_gmin(1)
+        do i = ind_newmin(1),ind_newmax(1)
+        j0 = ind_gmin(2)
+        do j = ind_newmin(2),ind_newmax(2)
+           New_Var % var % array2(i,j) =
+     &            Old_Var % var % array2(i0,j0)
+           New_Var % var % restore2D(i,j) = 1
+               j0 = j0 + int(dsnew(2)/dsold(2))
+        enddo
+        i0 = i0 + int(dsnew(1)/dsold(1))
+        enddo
+      CASE (3)
+        i0 = ind_gmin(1)
+        do i = ind_newmin(1),ind_newmax(1)
+        j0 = ind_gmin(2)
+        do j = ind_newmin(2),ind_newmax(2)
+        k0 = ind_gmin(3)
+        do k = ind_newmin(3),ind_newmax(3)
+           New_Var % var % array3(i,j,k) =
+     &                  Old_Var % var % array3(i0,j0,k0)
+           New_Var % var % restore3D(i,j,k) = 1   
+                     k0 = k0 + int(dsnew(3)/dsold(3))
+        enddo
+        j0 = j0 + int(dsnew(2)/dsold(2))
+        enddo
+        i0 = i0 + int(dsnew(1)/dsold(1))
+        enddo
+      CASE (4)
+        i0 = ind_gmin(1)
+        do i = ind_newmin(1),ind_newmax(1)
+        j0 = ind_gmin(2)
+        do j = ind_newmin(2),ind_newmax(2)
+        k0 = ind_gmin(3)
+        do k = ind_newmin(3),ind_newmax(3)
+        l0 = ind_gmin(4)
+        do l = ind_newmin(4),ind_newmax(4) 
+           New_Var % var % array4(i,j,k,l) =
+     &                        Old_Var % var % array4(i0,j0,k0,l0)
+           New_Var % var % restore4D(i,j,k,l) = 1   
+        l0 = l0 + int(dsnew(4)/dsold(4))
+        enddo
+        k0 = k0 + int(dsnew(3)/dsold(3))
+        enddo
+        j0 = j0 + int(dsnew(2)/dsold(2))
+        enddo
+        i0 = i0 + int(dsnew(1)/dsold(1))
+        enddo
+      CASE (5)
+        i0 = ind_gmin(1)
+        do i = ind_newmin(1),ind_newmax(1)
+        j0 = ind_gmin(2)
+        do j = ind_newmin(2),ind_newmax(2)
+        k0 = ind_gmin(3)
+        do k = ind_newmin(3),ind_newmax(3)
+        l0 = ind_gmin(4)
+        do l = ind_newmin(4),ind_newmax(4) 
+        m0 = ind_gmin(5)
+        do m = ind_newmin(5),ind_newmax(5)
+           New_Var % var % array5(i,j,k,l,m) =
+     &                        Old_Var % var % array5(i0,j0,k0,l0,m0)
+           New_Var % var % restore5D(i,j,k,l,m) = 1
+        m0 = m0 + int(dsnew(5)/dsold(5)) 
+        enddo
+        l0 = l0 + int(dsnew(4)/dsold(4))
+        enddo
+        k0 = k0 + int(dsnew(3)/dsold(3))
+        enddo
+        j0 = j0 + int(dsnew(2)/dsold(2))
+        enddo
+        i0 = i0 + int(dsnew(1)/dsold(1))
+        enddo
+      CASE (6)
+        i0 = ind_gmin(1)
+        do i = ind_newmin(1),ind_newmax(1)
+        j0 = ind_gmin(2)
+        do j = ind_newmin(2),ind_newmax(2)
+        k0 = ind_gmin(3)
+        do k = ind_newmin(3),ind_newmax(3)
+        l0 = ind_gmin(4)
+        do l = ind_newmin(4),ind_newmax(4) 
+        m0 = ind_gmin(5)
+        do m = ind_newmin(5),ind_newmax(5)
+        n0 = ind_gmin(6)
+        do n = ind_newmin(6),ind_newmax(6)
+           New_Var % var % array6(i,j,k,l,m,n) =
+     &                        Old_Var % var % array6(i0,j0,k0,l0,m0,n0)
+           New_Var % var % restore6D(i,j,k,l,m,n) = 1
+        n0 = n0 + int(dsnew(6)/dsold(6)) 
+        enddo
+        m0 = m0 + int(dsnew(5)/dsold(5)) 
+        enddo
+        l0 = l0 + int(dsnew(4)/dsold(4))
+        enddo
+        k0 = k0 + int(dsnew(3)/dsold(3))
+        enddo
+        j0 = j0 + int(dsnew(2)/dsold(2))
+        enddo
+        i0 = i0 + int(dsnew(1)/dsold(1))
+        enddo
+      END SELECT
+C           
+      Return
+C
+C
+      End Subroutine Agrif_CopynD                    
+C
+C
+C
+      End module Agrif_Save
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F	(revision 8201)
@@ -0,0 +1,460 @@
+C     Agrif (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place-Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_types  
+C
+      Module Agrif_types 
+C
+CCC   Description:
+CCC   Definition of data types used in Agrif, of several variables and
+C        PARAMETERs.     
+C
+      IMPLICIT NONE
+      
+C     Maximum refinement ratio
+
+      INTEGER, PARAMETER :: Agrif_MaxRaff = 7
+      
+C     Maximum number of grids of the hierarchy
+      INTEGER, PARAMETER :: Agrif_NbMaxGrids = 10
+C     MPI Communicator
+      INTEGER :: MPI_COMM_AGRIF
+C
+C     **************************************************************************
+CCC   TYPE Agrif_LRECTANGLE
+C     **************************************************************************
+C
+CCC   Description:
+CCC   Data TYPE allowing a grid to reach a grid on the same level or its child
+CCC   grids.
+C
+      TYPE Agrif_lrectangle  
+           TYPE(Agrif_rectangle) , Pointer :: r    ! to reach a child grid
+           TYPE(Agrif_lrectangle), Pointer :: next ! to reach a grid on the 
+                                                   !    same level
+      End TYPE Agrif_lrectangle  
+C
+C     **************************************************************************
+CCC   TYPE Agrif_RECTANGLE: 
+C     **************************************************************************
+C
+CCC   Description:
+CCC   Data TYPE to define several CHARACTERistics of a grid (number,position,
+CCC   time and space refinement factors,...). 
+C
+      TYPE Agrif_rectangle
+           INTEGER                         :: number      ! Number of the grid
+           ! Number of child grids 
+           INTEGER                         :: nbgridchild 
+           ! Minimal position in the x,y and z direction
+           INTEGER, DIMENSION(3)           :: imin        
+           ! Maximal position in the x,y and z direction 
+           INTEGER, DIMENSION(3)           :: imax 
+           ! Space refinement factor in the x,y and z direction  
+           INTEGER, DIMENSION(3)           :: spaceref    
+           ! Time refinement factor in the x,y and z direction
+           INTEGER, DIMENSION(3)           :: timeref     
+           ! Pointer to reach a grid on  the same level or a child grid
+           TYPE(Agrif_lrectangle), Pointer :: childgrids  
+      End TYPE Agrif_rectangle  
+C
+C
+C
+C     **************************************************************************
+CCC   TYPE Agrif_PGrid
+C     **************************************************************************
+C
+CCC   Description:
+CCC   Data TYPE to go over the grid hierarchy (used for the creation of this 
+CCC   grid hierarchy and during the time integration).
+C 
+      TYPE Agrif_pgrid  
+           ! allows to reach a child grid  
+           TYPE(Agrif_grid) , Pointer :: gr
+           ! allows to reach the grids of the same level 
+           TYPE(Agrif_pgrid), Pointer :: next 
+      End TYPE Agrif_pgrid 
+C
+C
+C
+C     **************************************************************************
+CCC   TYPE Agrif_PVariable
+C     **************************************************************************
+C
+CCC   Description:
+CCC   Data TYPE to define a grid variable.
+C
+      TYPE Agrif_PVariable 
+           ! This field allows to get the various CHARACTERistics 
+           !   of the variable (defined by the Agrif_Variable data TYPE)
+           TYPE(Agrif_Variable) , Pointer :: var  
+           ! Pointer on the parent grid
+           TYPE(Agrif_PVariable), Pointer :: parent_var 
+      End TYPE Agrif_PVariable 
+C
+C     **************************************************************************
+CCC   TYPE Agrif_Grid
+C     **************************************************************************
+C
+CCC   Description:
+CCC   Data TYPE to define a grid (position, space and time refinement factors).
+C
+      TYPE Agrif_grid  
+           ! pointer on the parent grid 
+           TYPE(Agrif_grid)                    ,Pointer :: parent      
+           ! pointer on the child grids 
+           TYPE(Agrif_pgrid)                   ,Pointer :: child_grids 
+           ! List of the grid variables   
+           TYPE(Agrif_PVariable), DIMENSION(:) ,Pointer :: tabvars     
+           ! pointer on the save grid 
+           TYPE(Agrif_grid)                    ,Pointer :: save_grid                
+C
+           ! Global x,y and z position
+           REAL    ,DIMENSION(3)                   :: Agrif_x   
+           ! Global space step in the x,y and z direction
+           REAL    ,DIMENSION(3)                   :: Agrif_d
+           ! number of cells in the x,y and z direction
+           INTEGER ,DIMENSION(3)                   :: nb        
+           ! minimal position in the x,y and z direction
+           INTEGER ,DIMENSION(3)                   :: ix        
+           ! Space refinement factor in the x,y and z direction
+           INTEGER ,DIMENSION(3)                   :: spaceref  
+           ! Time refinement factor in the x,y and z direction 
+           INTEGER ,DIMENSION(3)                   :: timeref   
+           INTEGER ,DIMENSION(:)          ,Pointer :: restore1D   
+           INTEGER ,DIMENSION(:,:)        ,Pointer :: restore2D   
+           INTEGER ,DIMENSION(:,:,:)      ,Pointer :: restore3D 
+           INTEGER ,DIMENSION(:,:,:,:)    ,Pointer :: restore4D
+           INTEGER ,DIMENSION(:,:,:,:,:)  ,Pointer :: restore5D
+           INTEGER ,DIMENSION(:,:,:,:,:,:),Pointer :: restore6D
+           ! number of time step  
+           INTEGER                                 :: ngridstep 
+           INTEGER                                 :: rank  
+           !moving grid id
+           INTEGER                                 :: grid_id
+           ! number of the grid 
+           INTEGER                                 :: fixedrank 
+           ! fixed or moving grid ?  
+           LOGICAL                                 :: fixed     
+           LOGICAL                                 :: oldgrid   
+C          LOGICALs indicating if the current grid has a common border 
+C             with the root coarse grid
+           LOGICAL ,DIMENSION(3)                   :: NearRootBorder
+           LOGICAL ,DIMENSION(3)                   :: DistantRootBorder
+C          Arrays for adaptive grid refinement
+           REAL    ,DIMENSION(:)          ,Pointer :: valtabpoint1D
+           REAL    ,DIMENSION(:,:)        ,Pointer :: valtabpoint2D
+           REAL    ,DIMENSION(:,:,:)      ,Pointer :: valtabpoint3D
+           INTEGER ,DIMENSION(:)          ,Pointer :: tabpoint1D
+           INTEGER ,DIMENSION(:,:)        ,Pointer :: tabpoint2D
+           INTEGER ,DIMENSION(:,:,:)      ,Pointer :: tabpoint3D
+           Type(Agrif_List_Variables), Pointer     :: variables=>NULL()
+           INTEGER                                 :: NbVariables = 0
+           Type(Agrif_Flux), Pointer               :: fluxes => NULL()
+           INTEGER                                 :: level
+           ! level of the grid in the hierarchy
+      End TYPE Agrif_grid
+C
+C     **************************************************************************
+CCC   TYPE Agrif_VARIABLE
+C     **************************************************************************
+C     
+CCC   Description:
+CCC   Data TYPE to CHARACTERize a grid variable.   
+C
+      TYPE Agrif_Variable 
+         CHARACTER*80 :: variablename
+C       
+         ! Pointer on the variable of the root grid 
+         TYPE(Agrif_Variable), Pointer :: root_var 
+C
+         ! index of the first point in the REAL domain (x,y and z direction)
+         INTEGER     ,DIMENSION(6)          :: point
+         ! position of the variable on the cell (1 for the boarder of 
+         !    the edge, 2 for the center)
+         INTEGER     ,DIMENSION(:) ,Pointer :: posvar      => NULL() 
+         ! Indication for the space interpolation (module Agrif_Boundary)
+         INTEGER                   ,Pointer :: interpIndex => NULL() 
+         ! number of DIMENSIONs of the grid variable
+         INTEGER                            :: nbdim = 0             
+         ! Array indicating the TYPE of DIMENSION (space or not) for 
+         !    each of them 
+         CHARACTER(6),DIMENSION(:) ,Pointer :: interptab   => NULL() 
+C        Arrays containing the values of the grid variables (REAL)
+         REAL                                    :: array0 
+         REAL   , DIMENSION(:)          ,ALLOCATABLE :: array1    
+         REAL   , DIMENSION(:,:)        ,ALLOCATABLE :: array2    
+         REAL   , DIMENSION(:,:,:)      ,ALLOCATABLE :: array3    
+         REAL   , DIMENSION(:,:,:,:)    ,ALLOCATABLE :: array4    
+         REAL   , DIMENSION(:,:,:,:,:)  ,ALLOCATABLE :: array5    
+         REAL   , DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: array6  
+         
+         REAL   , DIMENSION(:)          ,POINTER :: parray1    
+         REAL   , DIMENSION(:,:)        ,POINTER :: parray2    
+         REAL   , DIMENSION(:,:,:)      ,POINTER :: parray3    
+         REAL   , DIMENSION(:,:,:,:)    ,POINTER :: parray4    
+         REAL   , DIMENSION(:,:,:,:,:)  ,POINTER :: parray5    
+         REAL   , DIMENSION(:,:,:,:,:,:),POINTER :: parray6
+         
+C        Arrays containing the values of the grid variables (REAL*8)
+         REAL*8                                 :: darray0
+         REAL*8, DIMENSION(:)          ,ALLOCATABLE :: darray1   
+         REAL*8, DIMENSION(:,:)        ,ALLOCATABLE :: darray2   
+         REAL*8, DIMENSION(:,:,:)      ,ALLOCATABLE :: darray3   
+         REAL*8, DIMENSION(:,:,:,:)    ,ALLOCATABLE :: darray4   
+         REAL*8, DIMENSION(:,:,:,:,:)  ,ALLOCATABLE :: darray5   
+         REAL*8, DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: darray6   
+C        Arrays containing the values of the grid variables (REAL*4)
+         REAL*4                                 :: sarray0
+         REAL*4, DIMENSION(:)          ,ALLOCATABLE :: sarray1   
+         REAL*4, DIMENSION(:,:)        ,ALLOCATABLE :: sarray2   
+         REAL*4, DIMENSION(:,:,:)      ,ALLOCATABLE :: sarray3   
+         REAL*4, DIMENSION(:,:,:,:)    ,ALLOCATABLE :: sarray4   
+         REAL*4, DIMENSION(:,:,:,:,:)  ,ALLOCATABLE :: sarray5   
+         REAL*4, DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: sarray6   
+C        Arrays containing the values of the grid variables (LOGICAL)
+         LOGICAL                                 :: larray0
+         LOGICAL, DIMENSION(:)          ,ALLOCATABLE :: larray1   
+         LOGICAL, DIMENSION(:,:)        ,ALLOCATABLE :: larray2   
+         LOGICAL, DIMENSION(:,:,:)      ,ALLOCATABLE :: larray3   
+         LOGICAL, DIMENSION(:,:,:,:)    ,ALLOCATABLE :: larray4   
+         LOGICAL, DIMENSION(:,:,:,:,:)  ,ALLOCATABLE :: larray5   
+         LOGICAL, DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: larray6   
+C         Arrays containing the values of the grid variables (INTEGER)   
+         INTEGER                                 :: iarray0
+         INTEGER, DIMENSION(:)          ,ALLOCATABLE :: iarray1   
+         INTEGER, DIMENSION(:,:)        ,ALLOCATABLE :: iarray2   
+         INTEGER, DIMENSION(:,:,:)      ,ALLOCATABLE :: iarray3   
+         INTEGER, DIMENSION(:,:,:,:)    ,ALLOCATABLE :: iarray4   
+         INTEGER, DIMENSION(:,:,:,:,:)  ,ALLOCATABLE :: iarray5   
+         INTEGER, DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: iarray6   
+C
+         INTEGER, DIMENSION(:)          ,Pointer :: restore1D => NULL()
+         INTEGER, DIMENSION(:,:)        ,Pointer :: restore2D => NULL()
+         INTEGER, DIMENSION(:,:,:)      ,Pointer :: restore3D => NULL()
+         INTEGER, DIMENSION(:,:,:,:)    ,Pointer :: restore4D => NULL()
+         INTEGER, DIMENSION(:,:,:,:,:)  ,Pointer :: restore5D => NULL()
+         INTEGER, DIMENSION(:,:,:,:,:,:),Pointer :: restore6D => NULL()
+C   
+         CHARACTER(2050)                          :: carray0
+         CHARACTER(200), DIMENSION(:)    ,ALLOCATABLE :: carray1
+         CHARACTER(200), DIMENSION(:,:)  ,ALLOCATABLE :: carray2
+C
+         ! Array used for the time interpolation
+         REAL   , DIMENSION(:,:)      ,Pointer :: oldvalues2D => NULL()
+
+         ! if the variable should be restore -> =1
+         LOGICAL :: restaure = .FALSE.
+         ! the interpolation should be made in any case
+         LOGICAL :: Interpolationshouldbemade = .FALSE. 
+         INTEGER :: bcinf ! option bc
+         INTEGER :: bcsup ! option bc
+         INTEGER, DIMENSION(6) :: updateinf ! option update
+         INTEGER, DIMENSION(6) :: updatesup ! option update         
+         INTEGER, DIMENSION(6,6) :: bcTYPEinterp ! option bcinterp
+         INTEGER, DIMENSION(6) :: TYPEinterp ! option interp
+         INTEGER, DIMENSION(6) :: TYPEupdate ! option update
+         
+         INTEGER, DIMENSION(6) :: lb, ub
+         
+         Type(Agrif_List_Interp_Loc), Pointer :: list_interp => NULL()
+         Type(Agrif_List_Interp_Loc), Pointer :: list_update => NULL()
+C
+      End TYPE Agrif_Variable 
+      
+      Type Agrif_Interp_Loc
+      integer,dimension(6) :: pttab,petab,
+     &                          pttab_Child,pttab_Parent = -99
+      integer,dimension(6) :: indmin, indmax
+      INTEGER,DIMENSION(6)    :: pttruetab,cetruetab
+      logical :: member, memberin      
+#if !defined key_mpp_mpi      
+      integer,dimension(6) :: indminglob,indmaxglob
+#else
+      integer,dimension(6) :: indminglob2,indmaxglob2
+      INTEGER,DIMENSION(6,2,2) :: parentarray
+      INTEGER,DIMENSION(:,:,:), POINTER :: tab4t
+      LOGICAL, DIMENSION(:), POINTER :: memberinall
+      INTEGER,DIMENSION(:,:,:), POINTER :: tab5t
+      LOGICAL, DIMENSION(:), POINTER :: memberinall2
+      LOGICAL, DIMENSION(:), POINTER :: sendtoproc1    
+      LOGICAL, DIMENSION(:), POINTER :: recvfromproc1      
+      LOGICAL, DIMENSION(:), POINTER :: sendtoproc2      
+      LOGICAL, DIMENSION(:), POINTER :: recvfromproc2      
+#endif      
+      End Type Agrif_Interp_Loc
+      
+      Type Agrif_List_Interp_Loc
+      Type(Agrif_Interp_Loc), Pointer :: interp_loc
+      Type(Agrif_List_Interp_Loc), Pointer :: suiv
+      End Type Agrif_List_Interp_Loc
+
+       TYPE Agrif_List_Variables
+         Type(Agrif_PVariable), Pointer :: pvar
+         Type(Agrif_List_Variables), Pointer :: nextvariable  => NULL()
+       END TYPE Agrif_List_Variables
+               
+       TYPE Agrif_Profile
+          character*80 :: profilename
+C
+         ! index of the first point in the REAL domain (x,y and z direction)
+         INTEGER     ,DIMENSION(6)          :: point
+         ! position of the variable on the cell (1 for the boarder of 
+         !    the edge, 2 for the center)
+         INTEGER     ,DIMENSION(:) ,Pointer :: posvar      => NULL() 
+         ! Indication for the space interpolation (module Agrif_Boundary)
+         INTEGER                   ,Pointer :: interpIndex => NULL() 
+         ! number of DIMENSIONs of the grid variable
+         INTEGER                            :: nbdim = 0             
+         ! Array indicating the TYPE of DIMENSION (space or not) for 
+         !    each of them 
+         CHARACTER(6),DIMENSION(:) ,Pointer :: interptab   => NULL() 
+         Type(Agrif_Variable), Pointer :: var
+         Type(Agrif_Profile), Pointer :: nextprofile  => NULL()
+       END TYPE Agrif_Profile
+       
+       Type(Agrif_Profile), Pointer :: Agrif_MyProfiles => NULL()
+           
+C  Boundaries Fluxes
+
+      Type Agrif_Flux
+        Character*80 fluxname
+        Type(Agrif_Variable), Pointer :: fluxtabx
+        Type(Agrif_Variable), Pointer :: fluxtaby
+        Type(Agrif_Variable), Pointer :: fluxtabz        
+        Type(Agrif_Profile), Pointer  :: profile
+        Logical :: Fluxallocated = .FALSE.
+        Type(Agrif_Flux), Pointer     :: nextflux => NULL()
+      End Type Agrif_Flux      
+C
+C     **************************************************************************
+CCC   Different PARAMETERs
+C     **************************************************************************
+      TYPE(Agrif_PVariable), DIMENSION(:) ,Pointer :: Agrif_tabvars
+C
+      ! this pointer always points on the root grid of the grid hierarchy
+      TYPE(Agrif_grid)  ,Pointer :: Agrif_Mygrid      
+      ! Pointer used in the Agrif_regrid subroutine (Agrif_Util module). 
+      !    It contains  the safeguard of the grid hierarchy.
+      TYPE(Agrif_pgrid) ,Pointer :: Agrif_oldmygrid   
+      ! pointer to the current grid (the link is done by using the
+      !    Agrif_Instance   procedure (module Agrif_Init)) 
+      TYPE(Agrif_grid)  ,Pointer :: Agrif_Curgrid
+      ! Pointer used in the Agrif_ChildGrid_to_ParentGrid and 
+      !    Agrif_ParentGrid_to_ChildGrid subroutines 
+      !    (Agrif_CurgridFunctions module). It contains the 
+      !    safeguard of the current grid hierarchy.
+      TYPE(Agrif_grid)  ,Pointer :: Agrif_saveCURGRID
+C
+      ! Problem DIMENSION
+      INTEGER               :: Agrif_Probdim
+      ! number of variables
+      INTEGER               :: Agrif_NbVariables
+      ! number of fixed grids in the grid hierarchy
+      INTEGER               :: Agrif_nbfixedgrids            
+      ! space refinement factor
+      INTEGER ,DIMENSION(3) :: Agrif_coeffref
+      ! time refinement factor
+      INTEGER ,DIMENSION(3) :: Agrif_coeffreft
+      ! LOGICAL to use special values on the parent grid
+      LOGICAL               :: Agrif_UseSpecialValue
+      ! LOGICAL to use special values on the parent grid
+      LOGICAL               :: Agrif_UseSpecialValueInUpdate
+      ! LOGICAL to use special values on the current grid
+      LOGICAL               :: Agrif_UseSpecialValueFineGrid
+      ! Special values on the parent grid
+      REAL                  :: Agrif_SpecialValue
+      ! Special values on the current grid
+      REAL                  :: Agrif_SpecialValueFineGrid
+C   clustering PARAMETERs
+      INTEGER               :: Agrif_Regridding = 10
+      INTEGER               :: Agrif_Minwidth
+      REAL                  :: Agrif_Efficiency = 0.7
+      INTEGER               :: MaxSearch = 5
+      REAL    ,DIMENSION(3) :: Agrif_mind
+C     PARAMETERs for the interpolation of the child grids
+      ! linear interpolation
+      INTEGER ,PARAMETER    :: Agrif_linear=1
+      ! lagrange interpolation
+      INTEGER ,PARAMETER    :: Agrif_lagrange=2
+      ! spline interpolation
+      INTEGER ,PARAMETER    :: Agrif_eno=3
+      ! user s interpolation
+      INTEGER ,PARAMETER    :: Agrif_user_interp=4
+      ! constant interpolation
+      INTEGER ,PARAMETER    :: Agrif_constant=5
+      ! linear conservative interpolation 
+      INTEGER ,PARAMETER    :: Agrif_linearconserv=6
+      ! linear conservative interpolation       
+      INTEGER ,PARAMETER    :: Agrif_linearconservlim=7
+      INTEGER ,PARAMETER    :: Agrif_ppm=8 
+      INTEGER ,PARAMETER    :: Agrif_weno=9         
+C     PARAMETERs for the update of the parent grids      
+      INTEGER ,PARAMETER    :: Agrif_Update_Copy=1           ! copy
+      INTEGER ,PARAMETER    :: Agrif_Update_Average=2        ! average
+      INTEGER ,PARAMETER    :: Agrif_Update_Full_Weighting=3 ! full-weighting 
+C     Raffinement grid switch definition
+      ! Agrif_USE_ONLY_FIXED_GRIDS =1 if fixed grid mode
+      INTEGER               :: Agrif_USE_ONLY_FIXED_GRIDS    
+      ! Agrif_USE_FIXED_GRIDS = 1 if AMR mode + fixed grid 
+      !    else only AMR mode
+      INTEGER               :: Agrif_USE_FIXED_GRIDS
+      INTEGER               :: Agrif_Maxlevelloc
+C
+#ifdef key_mpp_mpi
+      INTEGER :: Agrif_Nbprocs  ! Number of processors
+      INTEGER :: Agrif_ProcRank ! Rank of the current processor 
+      INTEGER :: Agrif_Group    ! Group associated to MPI_COMM_AGRIF
+      INTEGER :: Agrif_MPIPREC
+#endif
+C
+      contains
+C   
+      Integer Function agrif_ceiling(x)
+C             
+          Real :: x
+          Integer ::i 
+C
+          i = floor(x)
+C      
+          if( abs(x - i).le.0.0001 )then
+             agrif_ceiling = i
+          else
+             agrif_ceiling = i+1
+          endif      
+C
+      End Function
+C
+      Integer Function agrif_int(x)
+C             
+          Real :: x
+          Integer ::i 
+C
+          i = floor(x) + 1
+C      
+          if( abs(x - i).le.0.0001 )then
+             agrif_int = i
+          else
+             agrif_int = i-1
+          endif      
+C
+      End Function
+      End Module Agrif_TYPEs  
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F	(revision 8201)
@@ -0,0 +1,2677 @@
+!
+! $Id: modupdate.F 2731 2011-04-08 12:05:35Z rblod $
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_Update
+C
+      Module Agrif_Update
+C
+CCC   Description:
+CCC   Module to update a parent grid from its child grids
+C
+C     Modules used:
+C   
+      Use Agrif_Updatebasic
+c      Use Agrif_Boundary
+      Use Agrif_Arrays
+      Use Agrif_CurgridFunctions
+      Use Agrif_Mask
+#ifdef key_mpp_mpi
+      Use Agrif_mpp
+#endif
+C
+      IMPLICIT NONE
+      logical, private :: precomputedone(7) = .FALSE.      
+C      
+      CONTAINS
+C     Define procedures contained in this module
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Update_1d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Update_1d(TypeUpdate,parent,child,tab,deb,fin,
+     &                           procname)
+C
+CCC   Description:
+CCC   Subroutine to update a 1D grid variable on the parent grid.
+C
+C     Declarations:
+C
+      
+C
+C     Arguments      
+      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations 
+                                              ! are done on the fine grid       
+      External :: procname
+      Optional ::  procname      
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1)
+     &         ), Target :: tab    ! Result
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE  
+      allocate(childtemp % var)
+C
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C      
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = 1  
+C      
+C     Values on the current grid used for the update
+C      childtemp % var % array1 => tab
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub             
+      
+C      childtemp % var % list_update => child%var%list_update
+             
+C
+     
+      IF (present(procname)) THEN
+      CALL Agrif_UpdateVariable
+     &     (TypeUpdate,parent,child,deb,fin,procname)
+      ELSE
+      CALL Agrif_UpdateVariable
+     &     (TypeUpdate,parent,child,deb,fin)
+      ENDIF     
+C      
+C      child % var % list_update => childtemp%var%list_update
+      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Update_1D
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Update_2d
+C     **************************************************************************
+C 
+
+      Subroutine Agrif_Update_2d(TypeUpdate,parent,child,tab,deb,fin,
+     &                           procname)
+C
+CCC   Description:
+CCC   Subroutine to update a 2D grid variable on the parent grid.
+C
+C     Declarations:
+C
+      
+C
+C     Arguments      
+      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations  
+                                              ! are done on the fine grid 
+                                              
+      External :: procname
+      Optional ::  procname
+                                                          
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2)
+     &    ), Target :: tab    ! Result
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE
+      allocate(childtemp % var)
+C
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C      
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = 2  
+C      
+C     Values on the current grid used for the update
+C      childtemp % var % array2 => tab 
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub             
+      
+C      childtemp % var % list_update => child%var%list_update      
+C
+      IF (present(procname)) THEN
+      CALL Agrif_UpdateVariable
+     &     (TypeUpdate,parent,child,deb,fin,procname)
+      ELSE
+      CALL Agrif_UpdateVariable
+     &     (TypeUpdate,parent,child,deb,fin)
+      ENDIF
+C      
+C      child % var % list_update => childtemp%var%list_update
+      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Update_2D
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Update_3d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Update_3d(TypeUpdate,parent,child,tab,deb,fin,
+     &                           procname)
+C
+CCC   Description:
+CCC   Subroutine to update a 3D grid variable on the parent grid.
+C
+C     Declarations:
+C
+      
+C
+C     Arguments      
+      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations 
+                                              ! are done on the fine grid    
+      External :: procname
+      Optional ::  procname
+                                                       
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3)
+     &      ), Target :: tab  ! Results  
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE  
+      allocate(childtemp % var)
+C
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C      
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = 3  
+C      
+C     Values on the current grid used for the update
+C      childtemp % var % array3 => tab     
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub  
+            
+      
+C      childtemp % var % list_update => child%var%list_update      
+C
+      IF (present(procname)) THEN
+      CALL Agrif_UpdateVariable
+     &     (TypeUpdate,parent,child,deb,fin,procname)
+      ELSE
+      CALL Agrif_UpdateVariable
+     &     (TypeUpdate,parent,child,deb,fin)
+      ENDIF
+C      
+C      child % var % list_update => childtemp%var%list_update
+      
+      DEALLOCATE(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Update_3D
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Update_4d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Update_4d(TypeUpdate,parent,child,tab,deb,fin,
+     &                           procname)
+C
+CCC   Description:
+CCC   Subroutine to update a 4D grid variable on the parent grid.
+C
+C     Declarations:
+C
+      
+C
+C     Arguments      
+      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations 
+                                              ! are done on the fine grid     
+      External :: procname
+      Optional ::  procname        
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3),
+     &         child%var%lb(4):child%var%ub(4)
+     &      ), Target :: tab  ! Results
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE  
+      allocate(childtemp % var)
+C
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C      
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = 4  
+C      
+C     Values on the current grid used for the update
+C      childtemp % var % array4 => tab     
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub  
+            
+      
+C      childtemp % var % list_update => child%var%list_update
+            
+C
+      IF (present(procname)) THEN
+      CALL Agrif_UpdateVariable
+     &     (TypeUpdate,parent,child,deb,fin,procname)
+      ELSE
+      CALL Agrif_UpdateVariable
+     &     (TypeUpdate,parent,child,deb,fin)
+      ENDIF
+
+C      child % var % list_update => childtemp%var%list_update      
+C
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Update_4D
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Update_5d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Update_5d(TypeUpdate,parent,child,tab,deb,fin,
+     &                           procname)
+C
+CCC   Description:
+CCC   Subroutine to update a 5D grid variable on the parent grid.
+C
+C     Declarations:
+C
+      
+C
+C     Arguments      
+      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations 
+                                              ! are done on the fine grid     
+      External :: procname
+      Optional ::  procname
+              
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3),
+     &         child%var%lb(4):child%var%ub(4),
+     &         child%var%lb(5):child%var%ub(5)
+     &      ),  Target :: tab  ! Results
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE  
+      allocate(childtemp % var)
+C
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = 5  
+C      
+C     Values on the current grid used for the update
+C      childtemp % var % array5 => tab      
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub        
+      
+C      childtemp % var % list_update => child%var%list_update      
+C
+      IF (present(procname)) THEN
+      CALL Agrif_UpdateVariable
+     &     (TypeUpdate,parent,child,deb,fin,procname)
+      ELSE
+      CALL Agrif_UpdateVariable
+     &     (TypeUpdate,parent,child,deb,fin)
+      ENDIF
+      
+C      child % var % list_update => childtemp%var%list_update
+            
+C      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Update_5D
+C
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Update_6d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Update_6d(TypeUpdate,parent,child,tab,deb,fin)
+C
+CCC   Description:
+CCC   Subroutine to update a 6D grid variable on the parent grid.
+C
+C     Declarations:
+C
+      
+C
+C     Arguments      
+      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations 
+                                              ! are done on the fine grid       
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3),
+     &         child%var%lb(4):child%var%ub(4),
+     &         child%var%lb(5):child%var%ub(5),
+     &         child%var%lb(6):child%var%ub(6)
+     &      ),  Target :: tab  ! Results
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE  
+      allocate(childtemp % var)
+C
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C      
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = 6  
+C      
+C     Values on the current grid used for the update
+C      childtemp % var % array6 => tab      
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub  
+            
+C      childtemp % var % list_update => child%var%list_update
+C
+      Call Agrif_UpdateVariable
+     &     (TypeUpdate,parent,child,deb,fin)
+     
+C      child % var % list_update => childtemp%var%list_update
+           
+C      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Update_6D
+C
+C
+C
+C     **************************************************************************  
+C     Subroutine Agrif_UpdateVariable    
+C     **************************************************************************  
+C   
+      Subroutine Agrif_UpdateVariable(TypeUpdate,parent,child,deb,fin,
+     &                   procname)   
+C
+CCC   Description:
+CCC   Subroutine to set arguments of Agrif_UpdatenD, n being the number of
+C         dimensions of the grid variable.
+C
+CC    Declarations:
+C      
+c      
+C      
+C     Scalar argument
+      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
+C     Data TYPE arguments
+      TYPE(AGRIF_PVariable) :: parent   ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child    ! Variable on the child grid 
+      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations 
+                                        !    are calculated     
+      External :: procname
+      Optional ::  procname
+      
+C
+C     Local scalars      
+      INTEGER :: nbdim                  ! Number of dimensions of the current
+                                        !    grid
+      INTEGER ,DIMENSION(6) :: pttab_child  
+      INTEGER ,DIMENSION(6) :: petab_child      
+      INTEGER ,DIMENSION(6) :: pttab_parent  
+      REAL    ,DIMENSION(6) :: s_child,s_parent
+      REAL    ,DIMENSION(6) :: ds_child,ds_parent
+      INTEGER,DIMENSION(6)          :: loctab_Child ! Indicates if the child
+                                        !    grid has a common border with 
+                                        !    the root grid            
+      TYPE(AGRIF_Variable), Pointer :: root               ! Variable on the root grid
+      INTEGER,DIMENSION(6)          :: posvartab_Child    ! Position of the
+                                        !    variable on the cell
+      INTEGER,DIMENSION(6)          :: nbtab_Child        ! Number of the cells    
+      INTEGER :: n              
+      LOGICAL :: wholeupdate
+C
+C 
+
+      loctab_child(:) = 0
+C
+      root => child % var % root_var 
+      nbdim = root % nbdim
+C
+      do n = 1,nbdim
+        posvartab_child(n) = root % posvar(n)
+      enddo
+C      
+      
+      Call PreProcessToInterpOrUpdate(parent,child,
+     &             petab_Child(1:nbdim),
+     &             pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
+     &             s_Child(1:nbdim),s_Parent(1:nbdim),
+     &             ds_Child(1:nbdim),ds_Parent(1:nbdim),
+     &             nbdim)
+C
+C
+      do n = 1,nbdim
+C
+        Select case(root % interptab(n))
+C
+          case('x') ! x DIMENSION
+C
+            nbtab_Child(n) = Agrif_Curgrid % nb(1)
+C
+          case('y') ! y DIMENSION      
+C
+            nbtab_Child(n) = Agrif_Curgrid % nb(2)
+C
+          case('z') ! z DIMENSION
+C
+            nbtab_Child(n) = Agrif_Curgrid % nb(3)
+C
+          case('N') ! No space DIMENSION      
+C
+            
+            nbtab_Child(n) = child % var % ub(n) - child % var % lb(n)
+C
+C           No interpolation but only a copy of the values of the grid variable      
+C      
+            posvartab_child(n) = 1
+            
+            loctab_child(n) = -3
+C
+        End select
+C
+      enddo
+      
+C     Call to a procedure of update according to the number of dimensions of
+C     the grid variable
+
+      wholeupdate = .FALSE.
+      
+      do n=1,nbdim
+      if (loctab_child(n) /= -3) then
+        if (deb(n)>fin(n)) wholeupdate = .TRUE.
+        if ((deb(n) == -99).AND.(deb(n)==fin(n))) wholeupdate=.TRUE.
+      endif
+      enddo
+
+       IF (present(procname)) THEN
+
+          IF (wholeupdate) THEN
+
+          Call AGRIF_UpdateWhole
+     &         (TypeUpdate,parent,child,deb,fin,
+     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
+     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
+     &          loctab_Child(1:nbdim),
+     &          s_Child(1:nbdim),s_Parent(1:nbdim),
+     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim,procname)  
+         ELSE
+          Call AGRIF_UpdateBcnD
+     &         (TypeUpdate,parent,child,deb,fin,
+     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
+     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
+     &          loctab_Child(1:nbdim),
+     &          s_Child(1:nbdim),s_Parent(1:nbdim),
+     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim,procname)  
+         ENDIF
+       ELSE
+         IF (wholeupdate) THEN
+          Call AGRIF_UpdateWhole
+     &         (TypeUpdate,parent,child,deb,fin,
+     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
+     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
+     &          loctab_Child(1:nbdim),
+     &          s_Child(1:nbdim),s_Parent(1:nbdim),
+     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim)
+         ELSE
+          Call AGRIF_UpdateBcnD
+     &         (TypeUpdate,parent,child,deb,fin,
+     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
+     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
+     &          loctab_Child(1:nbdim),
+     &          s_Child(1:nbdim),s_Parent(1:nbdim),
+     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim)
+         ENDIF
+       ENDIF
+C
+      Return
+C
+C
+      End subroutine Agrif_UpdateVariable
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_UpdateWhole
+C     **************************************************************************               
+C
+      Subroutine AGRIF_UpdateWhole(TypeUpdate,parent,child,deb,fin,
+     &                           pttab_child,pttab_Parent,
+     &                           nbtab_Child,posvartab_Child,
+     &                           loctab_Child,
+     &                           s_Child,s_Parent,
+     &                           ds_Child,ds_Parent,nbdim,procname)
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions for a nD grid variable on 
+CCC   a fine grid by using a space and time interpolations; it is called by the 
+CCC   Agrif_CorrectVariable procedure.
+C
+C
+C     Declarations:
+C
+      
+C
+#ifdef key_mpp_mpi
+C
+      INCLUDE 'mpif.h'
+C
+#endif
+C
+C     Arguments
+      INTEGER, DIMENSION(6) :: TypeUpdate            ! TYPE of update (copy or
+                                                     !    average) 
+      TYPE(AGRIF_PVariable)    :: parent             ! Variable on the parent
+                                                     !    grid
+      TYPE(AGRIF_PVariable)    :: child              ! Variable on the child
+                                                     !    grid 
+      INTEGER, DIMENSION(6) :: deb, fin
+      INTEGER                  :: nbdim              ! Number of dimensions of
+                                                     !    the grid variable
+      INTEGER,DIMENSION(nbdim) :: pttab_child        ! Index of the first point
+                                                     !    inside the domain for
+                                                     !    the parent grid
+                                                     !    variable
+      INTEGER,DIMENSION(nbdim) :: pttab_Parent       ! Index of the first point
+                                                     !    inside the domain for
+                                                     !    the child grid
+                                                     !    variable
+      INTEGER,DIMENSION(nbdim) :: nbtab_Child        ! Number of cells of the
+                                                     !    child grid
+      INTEGER,DIMENSION(nbdim) :: posvartab_Child    ! Position of the grid
+                                                     !    variable (1 or 2)
+      INTEGER,DIMENSION(nbdim) :: loctab_Child       ! Indicates if the child
+                                                     !    grid has a common
+                                                     !    border with the root
+                                                     !    grid
+      REAL   ,DIMENSION(nbdim) :: s_Child,s_Parent   ! Positions of the parent
+                                                     !    and child grids 
+      REAL   ,DIMENSION(nbdim) :: ds_Child,ds_Parent ! Space steps of the parent
+                                                     !    and child grids
+      External :: procname
+      Optional ::  procname      
+C
+C     Local variables     
+      INTEGER,DIMENSION(nbdim,2)   :: lubglob
+      INTEGER                      :: i                 
+      INTEGER,DIMENSION(nbdim,2,2) :: indtab         ! Arrays indicating the
+                                                     !    limits of the child
+      INTEGER,DIMENSION(nbdim,2,2) :: indtruetab     ! grid variable where
+                                                     !   boundary conditions are
+      integer :: coeffraf
+      INTEGER :: debloc, finloc
+C
+#ifdef key_mpp_mpi
+C
+      INTEGER,DIMENSION(nbdim)   :: lb,ub
+      INTEGER,DIMENSION(nbdim,2) :: iminmaxg
+      INTEGER                    :: code
+C
+#endif
+C      
+C
+C indtab contains the limits for the fine grid points that will be used
+C in the update scheme
+
+      DO i = 1, nbdim
+        coeffraf = nint(ds_Parent(i)/ds_Child(i))
+        debloc = 0
+        finloc = nbtab_Child(i)/coeffraf - 1
+
+        IF (posvartab_child(i) == 1) THEN
+           finloc = finloc - 1
+        ENDIF
+
+        IF (deb(i) > fin(i)) THEN
+          debloc = deb(i)
+          finloc = finloc - deb(i)
+        ENDIF
+
+        indtab(i,1,1) = pttab_child(i) + (debloc + 1) * coeffraf
+        indtab(i,1,2) = pttab_child(i) + (finloc + 1) * coeffraf
+
+        IF (posvartab_child(i) == 1) THEN
+          IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN
+            indtab(i,1,1) = indtab(i,1,1) - (coeffraf - 1)
+            indtab(i,1,2) = indtab(i,1,2) + (coeffraf - 1)        
+          ELSE IF (TypeUpdate(i) .NE. Agrif_Update_Copy) THEN
+            indtab(i,1,1) = indtab(i,1,1) - coeffraf / 2
+            indtab(i,1,2) = indtab(i,1,2) + coeffraf / 2
+          ENDIF
+        ELSE
+          indtab(i,1,1) = indtab(i,1,1) - coeffraf
+          indtab(i,1,2) = indtab(i,1,2) - 1
+C at this point, indices are OK for an average          
+          IF ((TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting)) THEN
+            indtab(i,1,1) = indtab(i,1,1) - coeffraf/2
+            indtab(i,1,2) = indtab(i,1,2) + coeffraf/2
+          ENDIF
+        ENDIF
+        IF (loctab_child(i) == -3) THEN
+           indtab(i,1,1) = pttab_child(i)
+C
+               if (posvartab_child(i) == 1) then
+C
+               indtab(i,1,2) = pttab_child(i) + nbtab_child(i) 
+C
+               else
+C
+               indtab(i,1,2) = pttab_child(i) + nbtab_child(i) - 1
+               ENDIF
+        ENDIF
+      ENDDO
+
+C lubglob contains the global lbound and ubound of the child array
+C lubglob(:,1) : global lbound for each dimension
+C lubglob(:,2) : global lbound for each dimension
+
+#if !defined key_mpp_mpi
+        Call Agrif_nbdim_Get_bound_dimension(child % var,lubglob(:,1),
+     &               lubglob(:,2),nbdim)
+C
+#else
+C     
+        Call Agrif_nbdim_Get_bound_dimension(child % var,lb,ub,nbdim)
+      DO i = 1,nbdim
+C
+        Call Agrif_Invloc(lb(i),Agrif_Procrank,i,iminmaxg(i,1))
+        Call Agrif_Invloc(ub(i),Agrif_Procrank,i,iminmaxg(i,2))
+C
+      ENDDO
+C
+      iminmaxg(1:nbdim,2) = - iminmaxg(1:nbdim,2)
+      
+      CALL MPI_ALLREDUCE(iminmaxg,lubglob,2*nbdim,MPI_INTEGER,MPI_MIN,
+     &                     MPI_COMM_AGRIF,code)
+
+      lubglob(1:nbdim,2) = - lubglob(1:nbdim,2)      
+C
+#endif 
+C
+      indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1),
+     &     lubglob(1:nbdim,1))
+      indtruetab(1:nbdim,1,2) = min(indtab(1:nbdim,1,2),
+     &     lubglob(1:nbdim,2))
+
+C
+C
+           IF (present(procname)) THEN
+              Call Agrif_UpdatenD              
+     &             (TypeUpdate,parent,child,
+     &              indtruetab(1:nbdim,1,1),indtruetab(1:nbdim,1,2),
+     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
+     &              s_Child(1:nbdim),s_Parent(1:nbdim),
+     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
+     &              posvartab_child,loctab_Child,
+     &              nbdim,procname)
+           ELSE
+              Call Agrif_UpdatenD              
+     &             (TypeUpdate,parent,child,
+     &              indtruetab(1:nbdim,1,1),indtruetab(1:nbdim,1,2),
+     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
+     &              s_Child(1:nbdim),s_Parent(1:nbdim),
+     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
+     &              posvartab_child,loctab_Child,
+     &              nbdim)           
+           ENDIF        
+C
+C      
+C  
+      End Subroutine Agrif_UpdateWhole
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_UpdateBcnd
+C     **************************************************************************               
+C
+      Subroutine AGRIF_UpdateBcnd(TypeUpdate,parent,child,deb,fin,
+     &                           pttab_child,pttab_Parent,
+     &                           nbtab_Child,posvartab_Child,
+     &                           loctab_Child,
+     &                           s_Child,s_Parent,
+     &                           ds_Child,ds_Parent,nbdim,procname)
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions for a nD grid variable on
+CCC   a fine grid by using a space and time interpolations; it is called by the 
+CCC   Agrif_CorrectVariable procedure.
+C
+C
+C     Declarations:
+C
+      
+C
+#ifdef key_mpp_mpi
+C
+       INCLUDE 'mpif.h'
+C
+#endif
+C
+C     Arguments
+      INTEGER, DIMENSION(6) :: TypeUpdate            ! TYPE of update 
+                                                     !   (copy or average) 
+      TYPE(AGRIF_PVariable)    :: parent             ! Variable on the parent
+                                                     !   grid
+      TYPE(AGRIF_PVariable)    :: child              ! Variable on the child
+                                                     !   grid 
+      INTEGER, DIMENSION(6) :: deb, fin
+      INTEGER                  :: nbdim              ! Number of dimensions of
+                                                     !   the grid variable
+      INTEGER,DIMENSION(nbdim) :: pttab_child        ! Index of the first point
+                                                     !   inside the domain for
+                                                     !   the parent grid
+                                                     !   variable
+      INTEGER,DIMENSION(nbdim) :: pttab_Parent       ! Index of the first point
+                                                     !   inside the domain for
+                                                     !   the child grid variable
+      INTEGER,DIMENSION(nbdim) :: nbtab_Child        ! Number of cells of the
+                                                     !   child grid
+      INTEGER,DIMENSION(nbdim) :: posvartab_Child    ! Position of the grid
+                                                     !   variable (1 or 2)
+      INTEGER,DIMENSION(nbdim) :: loctab_Child       ! Indicates if the child
+                                                     !   grid has a common
+                                                     !   border with the root
+                                                     !   grid
+      REAL   ,DIMENSION(nbdim) :: s_Child,s_Parent   ! Positions of the parent
+                                                     !   and child grids 
+      REAL   ,DIMENSION(nbdim) :: ds_Child,ds_Parent ! Space steps of the parent
+                                                     !   and child grids
+      External :: procname
+      Optional ::  procname      
+C
+C     Local variables
+      INTEGER,DIMENSION(nbdim,2)   :: lubglob
+      INTEGER                      :: i                 
+      INTEGER,DIMENSION(nbdim,2,2) :: indtab         ! Arrays indicating the
+                                                     !   limits of the child
+      INTEGER,DIMENSION(nbdim,2,2) :: indtruetab     ! grid variable where
+                                                     !  boundary conditions are 
+      INTEGER,DIMENSION(nbdim,2,2,nbdim)   :: ptres      ! calculated
+      INTEGER                      :: nb,ndir,n
+      integer :: coeffraf
+C
+#ifdef key_mpp_mpi
+C
+      INTEGER,DIMENSION(nbdim)   :: lb,ub
+      INTEGER,DIMENSION(nbdim,2) :: iminmaxg
+      INTEGER                    :: code
+C
+#endif
+C      
+C
+
+      DO i = 1, nbdim
+        coeffraf = nint(ds_Parent(i)/ds_Child(i))
+        indtab(i,1,1) = pttab_child(i) + (deb(i) + 1) * coeffraf
+        indtab(i,1,2) = pttab_child(i) + (fin(i) + 1) * coeffraf
+
+        indtab(i,2,1) = pttab_child(i) + nbtab_child(i)
+     &    - (fin(i) + 1) *  coeffraf
+        indtab(i,2,2) = pttab_child(i) + nbtab_child(i)
+     &    - (deb(i) + 1) *  coeffraf
+
+        IF (posvartab_child(i) == 1) THEN
+          IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN
+            indtab(i,:,1) = indtab(i,:,1) - (coeffraf - 1)
+            indtab(i,:,2) = indtab(i,:,2) + (coeffraf - 1)        
+          ELSE IF (TypeUpdate(i) .NE. Agrif_Update_Copy) THEN
+            indtab(i,:,1) = indtab(i,:,1) - coeffraf / 2
+            indtab(i,:,2) = indtab(i,:,2) + coeffraf / 2
+          ENDIF
+        ELSE
+          indtab(i,1,1) = indtab(i,1,1) - coeffraf
+          indtab(i,1,2) = indtab(i,1,2) - 1
+          indtab(i,2,2) = indtab(i,2,2) + coeffraf - 1
+          IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN
+            indtab(i,1,1) = indtab(i,1,1) - coeffraf/2
+            indtab(i,1,2) = indtab(i,1,2) + coeffraf/2
+            indtab(i,2,1) = indtab(i,2,1) - coeffraf/2
+            indtab(i,2,2) = indtab(i,2,2) + coeffraf/2
+          ENDIF          
+        ENDIF
+      ENDDO
+
+#if !defined key_mpp_mpi      
+        Call Agrif_nbdim_Get_bound_dimension(child % var,lubglob(:,1),
+     &               lubglob(:,2),nbdim)
+
+C
+#else
+C     
+        Call Agrif_nbdim_Get_bound_dimension(child % var,lb,ub,nbdim)
+      DO i = 1,nbdim
+C
+        Call Agrif_Invloc(lb(i),Agrif_Procrank,i,iminmaxg(i,1))
+        Call Agrif_Invloc(ub(i),Agrif_Procrank,i,iminmaxg(i,2))
+C
+      ENDDO
+C
+      iminmaxg(1:nbdim,2) = - iminmaxg(1:nbdim,2)
+      
+      CALL MPI_ALLREDUCE(iminmaxg,lubglob,2*nbdim,MPI_INTEGER,MPI_MIN,
+     &                     MPI_COMM_AGRIF,code)  
+     
+      lubglob(1:nbdim,2) = - lubglob(1:nbdim,2)      
+C
+#endif 
+C     
+      indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1),
+     &     lubglob(1:nbdim,1))
+      indtruetab(1:nbdim,1,2) = max(indtab(1:nbdim,1,2),
+     &     lubglob(1:nbdim,1))
+      indtruetab(1:nbdim,2,1) = min(indtab(1:nbdim,2,1),
+     &     lubglob(1:nbdim,2))
+      indtruetab(1:nbdim,2,2) = min(indtab(1:nbdim,2,2),
+     &     lubglob(1:nbdim,2))
+                        
+C 
+C
+      do nb = 1,nbdim
+C
+        do ndir = 1,2
+C
+          if (loctab_child(nb) /= -3) then
+C           
+              do n = 1,2
+C
+                ptres(nb,n,ndir,nb) = indtruetab(nb,ndir,n)
+C
+              enddo              
+C
+              do i = 1,nbdim
+C     
+                if (i .NE. nb) then      
+C
+                    if (loctab_child(i) == -3) then
+C
+                        ptres(i,1,ndir,nb) = pttab_child(i)
+C
+                      else
+C
+                        ptres(i,1,ndir,nb) = indtruetab(i,1,1)
+C
+                    endif
+C
+                    if (loctab_child(i) == -3) then
+C
+                        if (posvartab_child(i) == 1) then
+C
+                            ptres(i,2,ndir,nb) = pttab_child(i) 
+     &                                + nbtab_child(i)
+C
+                          else
+C
+                            ptres(i,2,ndir,nb) = pttab_child(i) 
+     &                             + nbtab_child(i) - 1
+C
+                        endif                             
+C
+                      else
+C
+                        ptres(i,2,ndir,nb) = indtruetab(i,2,2)
+C
+                    endif                        
+C      
+                endif
+C      
+              enddo
+      
+C
+            
+        endif
+      
+        enddo
+       enddo
+C
+
+C
+
+      do nb = 1,nbdim
+C
+        do ndir = 1,2                
+C
+          if (loctab_child(nb) /= -3) then
+C
+           IF (present(procname)) THEN
+              Call Agrif_UpdatenD              
+     &             (TypeUpdate,parent,child,
+     &              ptres(1:nbdim,1,ndir,nb),ptres(1:nbdim,2,ndir,nb),
+     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
+     &              s_Child(1:nbdim),s_Parent(1:nbdim),
+     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
+     &              posvartab_Child,loctab_Child,
+     &              nbdim,procname,nb,ndir)
+           ELSE
+              Call Agrif_UpdatenD              
+     &             (TypeUpdate,parent,child,
+     &              ptres(1:nbdim,1,ndir,nb),ptres(1:nbdim,2,ndir,nb),
+     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
+     &              s_Child(1:nbdim),s_Parent(1:nbdim),
+     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
+     &              posvartab_Child,loctab_Child,
+     &              nbdim)           
+           ENDIF
+C
+          endif
+          
+C
+        enddo       
+C
+      enddo
+C
+C      
+C  
+      End Subroutine Agrif_UpdateBcnd
+C
+C     **************************************************************************  
+CCC   Subroutine Agrif_UpdatenD  
+C     **************************************************************************  
+C  
+      Subroutine Agrif_UpdatenD(TypeUpdate,parent,child,
+     &                          pttab,petab,
+     &                          pttab_Child,pttab_Parent,
+     &                          s_Child,s_Parent,
+     &                          ds_Child,ds_Parent,
+     &                          posvartab_Child,loctab_Child,
+     &                          nbdim,procname,nb,ndir)  
+C
+C     Description:
+C     Subroutine to update a 2D grid variable on the parent grid of 
+C        the current grid. 
+C
+C     Declarations:
+C
+      
+C
+#ifdef key_mpp_mpi
+C
+       INCLUDE 'mpif.h'
+C
+#endif
+C
+C     Arguments
+      INTEGER                    :: nbdim
+      INTEGER, DIMENSION(6) :: TypeUpdate              ! TYPE of update 
+                                                       !  (copy or average)
+      TYPE(AGRIF_PVARIABLE)      :: parent             ! Variable of the parent
+                                                       !   grid   
+      TYPE(AGRIF_PVARIABLE)      :: child              ! Variable of the child
+                                                       !   grid
+      INTEGER,DIMENSION(nbdim)   :: pttab              ! Index of the first
+                                                       !   point inside the
+                                                       !   domain
+      INTEGER,DIMENSION(nbdim)   :: petab              ! Index of the first
+                                                       !   point inside the
+                                                       !   domain
+      INTEGER,DIMENSION(nbdim)   :: pttab_Child        ! Index of the first
+                                                       !   point inside the
+                                                       !   domain for the child
+                                                       !   grid variable
+      INTEGER,DIMENSION(nbdim)   :: pttab_Parent       ! Index of the first
+                                                       !   point inside the
+                                                       !   domain for the parent
+                                                       !   grid variable
+      REAL,DIMENSION(nbdim)      :: s_Child,s_Parent   ! Positions of the parent
+                                                       !   and child grids
+      REAL,DIMENSION(nbdim)      :: ds_Child,ds_Parent ! Space steps of the
+                                                       !   parent and child
+                                                       !   grids 
+      External :: procname
+      Optional ::  procname
+      Integer :: nb,ndir
+      Optional :: nb,ndir
+      
+C
+C     Local pointers
+      TYPE(AGRIF_PVARIABLE), SAVE      :: tempP      ! Temporary parent grid variable
+      TYPE(AGRIF_PVARIABLE), SAVE      :: tempC      ! Temporary child grid variable
+C
+C     Local scalars
+      INTEGER,DIMENSION(nbdim)    :: pttruetab,cetruetab
+      INTEGER,DIMENSION(nbdim)    :: posvartab_Child,loctab_Child
+      INTEGER,DIMENSION(nbdim)    :: indmin,indmax
+      INTEGER,DIMENSION(nbdim)    :: indminglob,indmaxglob
+      REAL   ,DIMENSION(nbdim)    :: s_Child_temp,s_Parent_temp
+cccccccc      LOGICAL,DIMENSION(nbdim)    :: noraftab
+      INTEGER,DIMENSION(nbdim)    :: lowerbound,upperbound
+      LOGICAL :: memberin, member
+      INTEGER,DIMENSION(nbdim)    :: pttruetabwhole,cetruetabwhole
+      INTEGER,DIMENSION(nbdim,2,2) :: childarray
+      INTEGER,DIMENSION(nbdim,2,2) :: parentarray
+      TYPE(AGRIF_PVARIABLE), SAVE      :: tempCextend,tempPextend ! Temporary child
+      INTEGER :: nbin, ndirin
+C
+#ifdef key_mpp_mpi
+C
+      INTEGER,DIMENSION(nbdim)    :: indminglob2,indmaxglob2
+      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1
+      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc2,recvfromproc2      
+      INTEGER                              :: code
+      INTEGER                              :: i,j,k
+      INTEGER,DIMENSION(nbdim,4)           :: tab3
+      INTEGER,DIMENSION(nbdim,4,0:Agrif_Nbprocs-1) :: tab4
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab5t      
+      LOGICAL :: find_list_update
+      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall, memberinall2
+      LOGICAL, DIMENSION(1) :: memberin1      
+C
+#endif
+C
+  
+C
+C     local lbound and ubound of the child array
+
+      Call Agrif_nbdim_Get_bound_dimension(child%var,
+     &                              lowerbound,upperbound,nbdim)
+
+C here pttab and petab corresponds to the (global) indices of the points needed
+C in the update
+C pttruetab and cetruetab contains only indices that are present
+C on the local processor
+
+      Call Agrif_Childbounds(nbdim,
+     &                       lowerbound,upperbound,
+     &                       pttab,petab,
+     &                       pttruetab,cetruetab,memberin)
+
+       Call Agrif_Prtbounds(nbdim,indminglob,indmaxglob,s_Parent_temp,
+     &                     s_Child_temp,s_Child,ds_Child,
+     &                     s_Parent,ds_Parent,
+     &                     pttab,petab,pttab_Child,
+     &                     pttab_Parent,
+     &                     posvartab_Child,TypeUpdate,loctab_Child
+#ifdef key_mpp_mpi
+     &                 ,pttruetabwhole,cetruetabwhole
+#endif
+     &     )
+
+#ifdef key_mpp_mpi
+      IF (memberin) THEN
+       Call Agrif_GlobtoLocInd2(childarray,
+     &                     lowerbound,upperbound,
+     &                     pttruetab,cetruetab,
+     &                     nbdim,Agrif_Procrank,
+     &                     member)
+
+      ENDIF
+
+
+         Call Agrif_Prtbounds(nbdim,indmin,indmax,s_Parent_temp,
+     &                     s_Child_temp,s_Child,ds_Child,
+     &                     s_Parent,ds_Parent,
+     &                     pttruetab,cetruetab,pttab_Child,
+     &                     pttab_Parent,
+     &                     posvartab_Child,TypeUpdate,loctab_Child
+     &                 ,pttruetabwhole,cetruetabwhole
+     &     )
+
+#else
+       indmin = indminglob
+       indmax = indmaxglob
+       pttruetabwhole = pttruetab
+       cetruetabwhole = cetruetab
+       childarray(:,1,2) = pttruetab
+       childarray(:,2,2) = cetruetab
+#endif
+
+       IF (present(procname)) THEN
+       IF (.Not.present(nb)) THEN
+       nbin=0
+       ndirin=0
+       ELSE
+       nbin = nb
+       ndirin = ndir
+       ENDIF
+       ENDIF
+       
+      IF (memberin) THEN
+      IF (.not.associated(tempC%var)) allocate(tempC%var)
+
+C
+      Call Agrif_nbdim_allocation(tempC%var,
+     &                 pttruetab,cetruetab,nbdim)
+
+      Call Agrif_nbdim_Full_VarEQreal(tempC%var,0.,nbdim)
+
+      IF (present(procname)) THEN
+        SELECT CASE (nbdim)
+        CASE(1)
+          CALL procname(tempC%var%array1,
+     &                          childarray(1,1,2),childarray(1,2,2),
+     &                                   .TRUE.,nbin,ndirin)
+        CASE(2)
+          CALL procname(tempC%var%array2,
+     &                          childarray(1,1,2),childarray(1,2,2),
+     &                          childarray(2,1,2),childarray(2,2,2),
+     &                                   .TRUE.,nbin,ndirin)
+        CASE(3)
+          CALL procname(tempC%var%array3,
+     &                          childarray(1,1,2),childarray(1,2,2),
+     &                          childarray(2,1,2),childarray(2,2,2),
+     &                          childarray(3,1,2),childarray(3,2,2),
+     &                                   .TRUE.,nbin,ndirin)
+        CASE(4)
+          CALL procname(tempC%var%array4,
+     &                          childarray(1,1,2),childarray(1,2,2),
+     &                          childarray(2,1,2),childarray(2,2,2),
+     &                          childarray(3,1,2),childarray(3,2,2),
+     &                          childarray(4,1,2),childarray(4,2,2),
+     &                                   .TRUE.,nbin,ndirin)
+        CASE(5)
+          CALL procname(tempC%var%array5,
+     &                          childarray(1,1,2),childarray(1,2,2),
+     &                          childarray(2,1,2),childarray(2,2,2),
+     &                          childarray(3,1,2),childarray(3,2,2),
+     &                          childarray(4,1,2),childarray(4,2,2),
+     &                          childarray(5,1,2),childarray(5,2,2),
+     &                                   .TRUE.,nbin,ndirin)
+        CASE(6)
+          CALL procname(tempC%var%array6,
+     &                          childarray(1,1,2),childarray(1,2,2),
+     &                          childarray(2,1,2),childarray(2,2,2),
+     &                          childarray(3,1,2),childarray(3,2,2),
+     &                          childarray(4,1,2),childarray(4,2,2),
+     &                          childarray(5,1,2),childarray(5,2,2),
+     &                          childarray(6,1,2),childarray(6,2,2),
+     &                                   .TRUE.,nbin,ndirin)
+        END SELECT
+      ELSE
+      Call Agrif_nbdim_VarEQvar(tempC%var,pttruetab,cetruetab,
+     &          child%var,childarray(:,1,2),childarray(:,2,2),
+     &                          nbdim)
+      ENDIF
+
+      ENDIF
+
+
+
+C
+C
+#ifdef key_mpp_mpi
+C
+C     tab2 contains the necessary limits of the parent grid for each processor
+
+      IF (Associated(child%var%list_update)) THEN
+      Call Agrif_Find_list_update(child%var%list_update,pttab,petab,
+     &                          pttab_Child,pttab_Parent,nbdim,
+     &       find_list_update,tab4t,tab5t,memberinall,memberinall2,
+     &     sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2)
+      ELSE
+      find_list_update = .FALSE.
+      ENDIF
+      
+      if (.not.find_list_update) then      
+      tab3(:,1) = pttruetab(:)
+      tab3(:,2) = cetruetab(:)
+      tab3(:,3) = pttruetabwhole(:)
+      tab3(:,4) = cetruetabwhole(:)
+C
+C
+      Call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,
+     &                   MPI_INTEGER,MPI_COMM_AGRIF,code)
+
+      IF (.not.associated(tempCextend%var)) Allocate(tempCextend%var)
+      DO k=0,Agrif_Nbprocs-1
+       do j=1,4
+         do i=1,nbdim
+         tab4t(i,k,j) = tab4(i,j,k)
+         enddo
+       enddo
+      enddo
+      
+      memberin1(1) = memberin
+      CALL MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall,
+     &                  1,MPI_LOGICAL,MPI_COMM_AGRIF,code)
+ 
+       Call Get_External_Data_first(tab4t(:,:,1),
+     &            tab4t(:,:,2),
+     &            tab4t(:,:,3),tab4t(:,:,4),nbdim,memberin,memberin,
+     &            memberinall,sendtoproc1,recvfromproc1,tab4t(:,:,5),
+     & tab4t(:,:,6),tab4t(:,:,7),tab4t(:,:,8))
+               
+      endif
+
+      Call ExchangeSameLevel2(sendtoproc1,recvfromproc1,nbdim,
+     &            tab4t(:,:,3),tab4t(:,:,4),tab4t(:,:,5),tab4t(:,:,6),
+     &            tab4t(:,:,7),tab4t(:,:,8),memberin,tempC,
+     &            tempCextend) 
+           
+!      Call Get_External_Data(tempC,tempCextend,tab4t(:,:,1),
+!     &            tab4t(:,:,2),
+!     &            tab4t(:,:,3),tab4t(:,:,4),nbdim,memberin,memberin,
+!     &            memberinall)
+
+#else
+      tempCextend%var => tempC%var
+#endif
+
+C
+C
+C     Update of the parent grid (tempP) from the child grid (tempC)
+
+
+      IF (memberin) THEN
+
+      IF (.not.associated(tempP%var)) allocate(tempP%var)
+      Call Agrif_nbdim_allocation(tempP%var,
+     &                 indmin,indmax,nbdim)
+
+      if ( nbdim .EQ. 1 ) then
+         tempP%var%array1 = 0.
+         Call Agrif_Update_1D_recursive(TypeUpdate,
+     &           tempP%var%array1,tempCextend%var%array1,
+     &           indmin,indmax,
+     &           pttruetabwhole,cetruetabwhole,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+      endif
+      if ( nbdim .EQ. 2 ) then
+         Call Agrif_Update_2D_recursive(TypeUpdate,
+     &           tempP%var%array2,tempCextend%var%array2,
+     &           indmin,indmax,
+     &           pttruetabwhole,cetruetabwhole,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+      endif
+
+      if ( nbdim .EQ. 3 ) then
+         Call Agrif_Update_3D_recursive(TypeUpdate,
+     &           tempP%var%array3,tempCextend%var%array3,
+     &           indmin,indmax,
+     &           pttruetabwhole,cetruetabwhole,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+      endif
+      if ( nbdim .EQ. 4 ) then
+         Call Agrif_Update_4D_recursive(TypeUpdate,
+     &           tempP%var%array4,tempCextend%var%array4,
+     &           indmin,indmax,
+     &           pttruetabwhole,cetruetabwhole,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+      endif
+      if ( nbdim .EQ. 5 ) then
+         Call Agrif_Update_5D_recursive(TypeUpdate,
+     &           tempP%var%array5,tempCextend%var%array5,
+     &           indmin,indmax,
+     &           pttruetabwhole,cetruetabwhole,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+      endif
+      if ( nbdim .EQ. 6 ) then
+         Call Agrif_Update_6D_recursive(TypeUpdate,
+     &           tempP%var%array6,tempCextend%var%array6,
+     &           indmin,indmax,
+     &           pttruetabwhole,cetruetabwhole,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+      endif
+
+      Call Agrif_nbdim_deallocation(tempCextend%var,nbdim)
+C      Deallocate(tempCextend%var)
+
+      ENDIF
+
+#ifdef key_mpp_mpi
+      Call Agrif_nbdim_Get_bound_dimension(parent%var,
+     &                              lowerbound,upperbound,nbdim)
+
+      Call Agrif_ChildGrid_to_ParentGrid()
+C
+      Call Agrif_Childbounds(nbdim,
+     &                       lowerbound,upperbound,
+     &                       indminglob,indmaxglob,
+     &                       indminglob2,indmaxglob2,member)
+C
+      IF (member) THEN
+      Call Agrif_GlobtoLocInd2(parentarray,
+     &                     lowerbound,upperbound,
+     &                     indminglob2,indmaxglob2,
+     &                     nbdim,Agrif_Procrank,
+     &                     member)
+      ENDIF
+
+      Call Agrif_ParentGrid_to_ChildGrid()
+
+      if (.not.find_list_update) then
+      tab3(:,1) = indmin(:)
+      tab3(:,2) = indmax(:)
+      tab3(:,3) = indminglob2(:)
+      tab3(:,4) = indmaxglob2(:)
+C
+      Call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,
+     &                   MPI_INTEGER,MPI_COMM_AGRIF,code)
+
+      IF (.not.associated(tempPextend%var)) Allocate(tempPextend%var)
+      DO k=0,Agrif_Nbprocs-1
+       do j=1,4
+         do i=1,nbdim
+         tab5t(i,k,j) = tab4(i,j,k)
+         enddo
+       enddo
+      enddo
+ 
+      memberin1(1) = member
+      CALL MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall2,
+     &                  1,MPI_LOGICAL,MPI_COMM_AGRIF,code)
+ 
+      Call Get_External_Data_first(tab5t(:,:,1),
+     &            tab5t(:,:,2),
+     &            tab5t(:,:,3),tab5t(:,:,4),nbdim,memberin,member,
+     &            memberinall2,sendtoproc2,recvfromproc2,tab5t(:,:,5),
+     & tab5t(:,:,6),tab5t(:,:,7),tab5t(:,:,8))
+          
+      Call Agrif_Addto_list_update(child%var%list_update,pttab,petab,
+     &                          pttab_Child,pttab_Parent,nbdim
+     &   ,tab4t,tab5t,memberinall,memberinall2,
+     &   sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2) 
+          
+      endif
+      
+c      Call Get_External_Data(tempP,tempPextend,tab5t(:,:,1),
+c     &            tab5t(:,:,2),
+c     &            tab5t(:,:,3),tab5t(:,:,4),nbdim,memberin,member,
+c     &            memberinall2)
+     
+      Call ExchangeSameLevel2(sendtoproc2,recvfromproc2,nbdim,
+     &            tab5t(:,:,3),tab5t(:,:,4),tab5t(:,:,5),tab5t(:,:,6),
+     &            tab5t(:,:,7),tab5t(:,:,8),member,tempP,
+     &            tempPextend)     
+
+#else
+      tempPextend%var => tempP%var
+      parentarray(:,1,1) = indmin
+      parentarray(:,2,1) = indmax
+      parentarray(:,1,2) = indmin
+      parentarray(:,2,2) = indmax
+      member = .TRUE.
+#endif
+
+C
+C
+C
+C     Special values on the child grid
+      if (Agrif_UseSpecialValueFineGrid) then
+C
+ccc         noraftab(1:nbdim) =
+ccc     &    child % var % root_var % interptab(1:nbdim) .EQ. 'N'
+C
+#ifdef key_mpp_mpi
+C
+c          Allocate(childvalues% var)
+C
+c          Call Agrif_nbdim_allocation(childvalues%var,
+c     &                      pttruetab,cetruetab,nbdim)
+c          Call Agrif_nbdim_Full_VarEQvar(childvalues% var,
+c     &                                tempC% var,
+c     &                                nbdim)
+c          Call Agrif_CheckMasknD(tempC,childvalues,
+c     &                           pttruetab(1:nbdim),cetruetab(1:nbdim),
+c     &                           pttruetab(1:nbdim),cetruetab(1:nbdim),
+c     &                           noraftab(1:nbdim),nbdim)
+c          Call Agrif_nbdim_deallocation(childvalues% var,nbdim)
+c         Deallocate(childvalues % var)
+C
+#else
+C
+c          Call Agrif_nbdim_Get_bound_dimension(child%var,
+c     &                              lowerbound,upperbound,nbdim)
+c          Call Agrif_CheckMasknD(tempC,child,
+c     &                           pttruetab(1:nbdim),cetruetab(1:nbdim),
+c     &                           lowerbound,
+c     &                           upperbound,
+c     &                           noraftab(1:nbdim),nbdim)
+C
+#endif
+C
+      endif
+
+
+C
+C
+C
+C
+C     Special values on the parent grid
+      if (Agrif_UseSpecialValue) then
+C
+#ifdef key_mpp_mpi
+C
+c          Call GiveAgrif_SpecialValueToTab_mpi(parent%var,tempP%var,
+c     &                 parentarray,
+c     &                 indmin,indmax,
+c     &                 Agrif_SpecialValue,nbdim)
+C
+C
+#else
+C
+c          Call GiveAgrif_SpecialValueToTab(parent%var,tempP%var,
+c     &                  indmin,indmax,
+c     &                  Agrif_SpecialValue,nbdim)
+C
+#endif
+C
+C
+      endif   
+C
+C
+        IF (member) THEN
+
+          IF (present(procname)) THEN
+            CALL Agrif_ChildGrid_to_ParentGrid()
+            SELECT CASE(nbdim)
+            CASE(1)
+            CALL procname(
+     &      tempPextend%var%array1(
+     &                      parentarray(1,1,1):parentarray(1,2,1)),
+     &                      parentarray(1,1,2),parentarray(1,2,2),
+     &                                   .FALSE.,nbin,ndirin
+     &                      )
+            CASE(2)
+            CALL procname(
+     &      tempPextend%var%array2(
+     &                      parentarray(1,1,1):parentarray(1,2,1),
+     &                      parentarray(2,1,1):parentarray(2,2,1)),
+     &                      parentarray(1,1,2),parentarray(1,2,2),
+     &                      parentarray(2,1,2),parentarray(2,2,2),
+     &                                   .FALSE.,nbin,ndirin
+     &                      )
+            CASE(3)
+            CALL procname(
+     &      tempPextend%var%array3(
+     &                      parentarray(1,1,1):parentarray(1,2,1),
+     &                      parentarray(2,1,1):parentarray(2,2,1),
+     &                      parentarray(3,1,1):parentarray(3,2,1)),
+     &                      parentarray(1,1,2),parentarray(1,2,2),
+     &                      parentarray(2,1,2),parentarray(2,2,2),
+     &                      parentarray(3,1,2),parentarray(3,2,2),
+     &                                   .FALSE.,nbin,ndirin
+     &                      )
+            CASE(4)
+            CALL procname(
+     &      tempPextend%var%array4(
+     &                      parentarray(1,1,1):parentarray(1,2,1),
+     &                      parentarray(2,1,1):parentarray(2,2,1),
+     &                      parentarray(3,1,1):parentarray(3,2,1),
+     &                      parentarray(4,1,1):parentarray(4,2,1)),
+     &                      parentarray(1,1,2),parentarray(1,2,2),
+     &                      parentarray(2,1,2),parentarray(2,2,2),
+     &                      parentarray(3,1,2),parentarray(3,2,2),
+     &                      parentarray(4,1,2),parentarray(4,2,2),
+     &                                   .FALSE.,nbin,ndirin
+     &                      )
+            CASE(5)
+            CALL procname(
+     &      tempPextend%var%array5(
+     &                      parentarray(1,1,1):parentarray(1,2,1),
+     &                      parentarray(2,1,1):parentarray(2,2,1),
+     &                      parentarray(3,1,1):parentarray(3,2,1),
+     &                      parentarray(4,1,1):parentarray(4,2,1),
+     &                      parentarray(5,1,1):parentarray(5,2,1)),
+     &                      parentarray(1,1,2),parentarray(1,2,2),
+     &                      parentarray(2,1,2),parentarray(2,2,2),
+     &                      parentarray(3,1,2),parentarray(3,2,2),
+     &                      parentarray(4,1,2),parentarray(4,2,2),
+     &                      parentarray(5,1,2),parentarray(5,2,2),
+     &                                   .FALSE.,nbin,ndirin
+     &                      )
+            CASE(6)
+            CALL procname(
+     &      tempPextend%var%array6(
+     &                      parentarray(1,1,1):parentarray(1,2,1),
+     &                      parentarray(2,1,1):parentarray(2,2,1),
+     &                      parentarray(3,1,1):parentarray(3,2,1),
+     &                      parentarray(4,1,1):parentarray(4,2,1),
+     &                      parentarray(5,1,1):parentarray(5,2,1),
+     &                      parentarray(6,1,1):parentarray(6,2,1)),
+     &                      parentarray(1,1,2),parentarray(1,2,2),
+     &                      parentarray(2,1,2),parentarray(2,2,2),
+     &                      parentarray(3,1,2),parentarray(3,2,2),
+     &                      parentarray(4,1,2),parentarray(4,2,2),
+     &                      parentarray(5,1,2),parentarray(5,2,2),
+     &                      parentarray(6,1,2),parentarray(6,2,2),
+     &                                   .FALSE.,nbin,ndirin
+     &                      )
+            END SELECT
+            CALL Agrif_ParentGrid_to_ChildGrid()
+          ELSE
+            SELECT CASE(nbdim)
+            CASE(1)
+            parent%var%array1(parentarray(1,1,2):parentarray(1,2,2)) =
+     &      tempPextend%var%array1(
+     &                      parentarray(1,1,1):parentarray(1,2,1))
+            CASE(2)
+            parent%var%array2(parentarray(1,1,2):parentarray(1,2,2),
+     &                      parentarray(2,1,2):parentarray(2,2,2)) =
+     &      tempPextend%var%array2(
+     &                      parentarray(1,1,1):parentarray(1,2,1),
+     &                      parentarray(2,1,1):parentarray(2,2,1))
+            CASE(3)
+            parent%var%array3(parentarray(1,1,2):parentarray(1,2,2),
+     &                      parentarray(2,1,2):parentarray(2,2,2),
+     &                      parentarray(3,1,2):parentarray(3,2,2)) =
+     &      tempPextend%var%array3(
+     &                      parentarray(1,1,1):parentarray(1,2,1),
+     &                      parentarray(2,1,1):parentarray(2,2,1),
+     &                      parentarray(3,1,1):parentarray(3,2,1))
+            CASE(4)
+            parent%var%array4(parentarray(1,1,2):parentarray(1,2,2),
+     &                      parentarray(2,1,2):parentarray(2,2,2),
+     &                      parentarray(3,1,2):parentarray(3,2,2),
+     &                      parentarray(4,1,2):parentarray(4,2,2)) =
+     &      tempPextend%var%array4(
+     &                      parentarray(1,1,1):parentarray(1,2,1),
+     &                      parentarray(2,1,1):parentarray(2,2,1),
+     &                      parentarray(3,1,1):parentarray(3,2,1),
+     &                      parentarray(4,1,1):parentarray(4,2,1))
+            CASE(5)
+            parent%var%array5(parentarray(1,1,2):parentarray(1,2,2),
+     &                      parentarray(2,1,2):parentarray(2,2,2),
+     &                      parentarray(3,1,2):parentarray(3,2,2),
+     &                      parentarray(4,1,2):parentarray(4,2,2),
+     &                      parentarray(5,1,2):parentarray(5,2,2)) =
+     &      tempPextend%var%array5(
+     &                      parentarray(1,1,1):parentarray(1,2,1),
+     &                      parentarray(2,1,1):parentarray(2,2,1),
+     &                      parentarray(3,1,1):parentarray(3,2,1),
+     &                      parentarray(4,1,1):parentarray(4,2,1),
+     &                      parentarray(5,1,1):parentarray(5,2,1))
+            CASE(6)
+            parent%var%array6(parentarray(1,1,2):parentarray(1,2,2),
+     &                      parentarray(2,1,2):parentarray(2,2,2),
+     &                      parentarray(3,1,2):parentarray(3,2,2),
+     &                      parentarray(4,1,2):parentarray(4,2,2),
+     &                      parentarray(5,1,2):parentarray(5,2,2),
+     &                      parentarray(6,1,2):parentarray(6,2,2)) =
+     &      tempPextend%var%array6(
+     &                      parentarray(1,1,1):parentarray(1,2,1),
+     &                      parentarray(2,1,1):parentarray(2,2,1),
+     &                      parentarray(3,1,1):parentarray(3,2,1),
+     &                      parentarray(4,1,1):parentarray(4,2,1),
+     &                      parentarray(5,1,1):parentarray(5,2,1),
+     &                      parentarray(6,1,1):parentarray(6,2,1))
+            END SELECT
+          ENDIF
+
+        Call Agrif_nbdim_deallocation(tempPextend%var,nbdim)
+       ENDIF
+C
+C
+C     Deallocations
+
+      IF (memberin) THEN
+#ifdef key_mpp_mpi
+      Call Agrif_nbdim_deallocation(tempP%var,nbdim)
+      Call Agrif_nbdim_deallocation(tempC%var,nbdim)
+!      Deallocate(tempC % var)
+#endif
+!      Deallocate(tempP % var)
+      ENDIF
+#ifdef key_mpp_mpi
+!      Deallocate(tempPextend%var)
+!      IF (.Not.memberin) Deallocate(tempCextend%var)
+#endif
+
+C
+C
+      End Subroutine Agrif_UpdatenD
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Prtbounds
+C     **************************************************************************
+C
+      Subroutine Agrif_Prtbounds(nbdim,indmin,indmax,s_Parent_temp,
+     &                              s_Child_temp,s_Child,ds_Child,
+     &                              s_Parent,ds_Parent,
+     &                              pttruetab,cetruetab,pttab_Child,
+     &                              pttab_Parent,
+     &                              posvartab_child,TypeUpdate,
+     &                              loctab_Child
+#ifdef key_mpp_mpi
+     &                 ,pttruetabwhole,cetruetabwhole
+#endif
+     &                 )
+C
+CCC   Description:
+CCC   Subroutine calculating the bounds of the parent grid to be updated
+CCC   by the child grid     
+C
+C
+C     Declarations:
+C
+      
+C
+#ifdef key_mpp_mpi
+cccccccccccccccccccccccccc#include "mpif.h"
+#endif
+C
+C     Arguments
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim) :: indmin,indmax
+      REAL,DIMENSION(nbdim) :: s_Parent_temp,s_child_temp
+      REAL,DIMENSION(nbdim) :: s_Child,ds_child
+      REAL,DIMENSION(nbdim) :: s_Parent,ds_Parent
+      INTEGER,DIMENSION(nbdim) :: pttruetab,cetruetab
+      INTEGER,DIMENSION(nbdim) :: posvartab_child,TypeUpdate
+      INTEGER,DIMENSION(nbdim) :: loctab_Child
+      INTEGER,DIMENSION(nbdim) :: pttab_Child,pttab_Parent
+C
+C     Local variables
+      INTEGER :: i
+      REAL,DIMENSION(nbdim) :: dim_newmin,dim_newmax      
+#ifdef key_mpp_mpi
+      INTEGER,DIMENSION(nbdim)    :: pttruetabwhole,cetruetabwhole
+      REAL :: positionmin,positionmax
+      INTEGER :: imin,imax
+      INTEGER :: coeffraf
+#endif
+C
+C
+      do i = 1,nbdim
+C
+        dim_newmin(i) = s_Child(i) + (pttruetab(i) -
+     &                                pttab_Child(i)) * ds_Child(i)
+C
+        dim_newmax(i) = s_Child(i) + (cetruetab(i) - 
+     &                                pttab_Child(i)) * ds_Child(i)
+C     
+        indmin(i) = pttab_Parent(i) +
+     &        agrif_ceiling((dim_newmin(i)-s_Parent(i))/ds_Parent(i))
+C
+        indmax(i) = pttab_Parent(i) +
+     &        agrif_int((dim_newmax(i)-s_Parent(i))/ds_Parent(i))
+C
+#ifdef key_mpp_mpi
+        positionmin = s_Parent(i) + (indmin(i)-
+     &                          pttab_Parent(i))*ds_Parent(i)
+        IF (loctab_Child(i) .NE. -3) THEN
+        IF (posvartab_child(i) == 1) THEN
+          IF (TypeUpdate(i) .EQ. Agrif_Update_Average) THEN
+          positionmin = positionmin - ds_Parent(i)/2.
+          ELSE IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN
+          positionmin = positionmin - (ds_Parent(i)-ds_Child(i))
+          ENDIF
+        ELSE
+          IF (TypeUpdate(i).NE.Agrif_Update_Full_Weighting) THEN
+        positionmin = positionmin - ds_Parent(i)/2.
+          ELSE
+          coeffraf = nint(ds_Parent(i)/ds_Child(i))
+          if (mod(coeffraf,2) == 1) then
+            positionmin = positionmin - (ds_Parent(i)-ds_Child(i))
+          else
+            positionmin = positionmin - (ds_Parent(i)-ds_Child(i))
+     &                                -ds_Child(i)/2.
+          endif
+        ENDIF
+        ENDIF
+        ENDIF
+        imin = pttab_Child(i) +
+     &        agrif_ceiling((positionmin-s_Child(i))/ds_Child(i))
+
+       positionmin = s_Child(i) + (imin -
+     &                             pttab_Child(i)) * ds_Child(i)
+
+        pttruetabwhole(i) = imin
+
+        positionmax = s_Parent(i) + (indmax(i)-
+     &                          pttab_Parent(i))*ds_Parent(i)
+        IF (loctab_Child(i) .NE. -3) THEN
+        IF (posvartab_child(i) == 1) THEN
+          IF (TypeUpdate(i) .EQ. Agrif_Update_Average) THEN
+        positionmax = positionmax  + ds_Parent(i)/2.
+          ELSE IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN
+          positionmax = positionmax  + (ds_Parent(i)-ds_Child(i))
+          ENDIF
+        ELSE
+          IF (TypeUpdate(i).NE.Agrif_Update_Full_Weighting) THEN        
+        positionmax = positionmax  + ds_Parent(i)/2.
+          ELSE
+          coeffraf = nint(ds_Parent(i)/ds_Child(i))
+          if (mod(coeffraf,2) == 1) then
+            positionmax = positionmax + (ds_Parent(i)-ds_Child(i))
+          else
+            positionmax = positionmax + (ds_Parent(i)-ds_Child(i)) 
+     &                                + ds_Child(i)/2.
+          endif
+
+        ENDIF        
+        ENDIF
+        ENDIF
+        imax = pttab_Child(i) +
+     &        agrif_int((positionmax-s_Child(i))/ds_Child(i))
+
+        positionmax = s_Child(i) + (imax -
+     &                                pttab_Child(i)) * ds_Child(i)
+
+        cetruetabwhole(i) = imax
+
+#endif
+C
+        s_Parent_temp(i) = s_Parent(i) + 
+     &                     (indmin(i) - pttab_Parent(i)) * 
+     &                      ds_Parent(i) 
+C     
+        s_Child_temp(i) = dim_newmin(i)
+
+#ifdef key_mpp_mpi
+        s_Child_temp(i) = positionmin
+#endif
+C
+      enddo
+C
+      Return
+C
+C
+      End Subroutine Agrif_Prtbounds
+C
+C
+C
+C
+
+C
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Agrif_Update_2D_Recursive 
+C     **************************************************************************
+C
+      Subroutine Agrif_Update_2D_recursive(TypeUpdate,tempP,tempC,
+     &                                     indmin,indmax,
+     &                                     pttab_child,petab_child,
+     &                                     s_child,s_parent,
+     &                                     ds_child,ds_parent,nbdim)
+C
+CCC   Description:
+CCC   Subroutine to update a 2D grid variable on the parent grid. 
+CCC   It calls Agrif_Update_1D_Recursive and Agrif_UpdateBase.   
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C     
+      INTEGER                   :: nbdim
+      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL, DIMENSION(nbdim)    :: s_child,s_parent
+      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
+      REAL, DIMENSION(indmin(1):indmax(1),
+     &                indmin(2):indmax(2))           :: tempP
+C      REAL, DIMENSION(pttab_child(1):petab_child(1),
+C     &                pttab_child(2):petab_child(2)) :: tempC
+     
+      REAL, DIMENSION(:,:) :: tempC     
+C
+C     Local variables      
+      REAL, DIMENSION(indmin(1):indmax(1),
+     &                 pttab_child(2):petab_child(2)) :: tabtemp
+      REAL, DIMENSION(indmin(2):indmax(2),
+     &                indmin(1):indmax(1))           :: tempP_trsp
+      REAL, DIMENSION(pttab_child(2):petab_child(2),
+     &                 indmin(1):indmax(1)) :: tabtemp_trsp
+      INTEGER :: i,j
+      INTEGER :: coeffraf,locind_child_left
+C
+      tabtemp = 0.
+
+
+      coeffraf = nint ( ds_parent(1) / ds_child(1) ) 
+      IF((TypeUpdate(1) == AGRIF_Update_average) 
+     &                 .AND. (coeffraf /= 1 ))THEN
+!---CDIR NEXPAND
+         IF(.NOT. precomputedone(1) ) Call average1Dprecompute2D
+     &       (petab_child(2)-pttab_child(2)+1,
+     &        indmax(1)-indmin(1)+1,
+     &        petab_child(1)-pttab_child(1)+1,
+     &        s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+!---CDIR NEXPAND
+          Call average1Daftercompute
+     &       (  tabtemp, tempC,
+     &          size(tabtemp), size(tempC),
+     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+ 
+      ELSEIF((TypeUpdate(1) == AGRIF_Update_copy)
+     &                 .AND. (coeffraf /= 1 ))THEN
+!---CDIR NEXPAND
+         IF(.NOT. precomputedone(1) ) Call copy1Dprecompute2D
+     &       (petab_child(2)-pttab_child(2)+1,
+     &        indmax(1)-indmin(1)+1,
+     &        petab_child(1)-pttab_child(1)+1,
+     &        s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+!---CDIR NEXPAND
+          Call copy1Daftercompute
+     &       (  tabtemp, tempC,
+     &          size(tabtemp), size(tempC),
+     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+
+      ELSE
+      do j = pttab_child(nbdim),petab_child(nbdim)
+C
+!---CDIR NEXPAND
+        Call Agrif_Update_1D_recursive(TypeUpdate(1:nbdim-1),    
+     &         tabtemp(:,j),
+     &         tempC(:,j-pttab_child(nbdim)+1),
+     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
+     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
+     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
+     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
+C
+      enddo
+      ENDIF
+      tabtemp_trsp = TRANSPOSE(tabtemp) 
+      coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
+    
+!---CDIR NEXPAND
+      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
+     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
+C
+      
+      tempP_trsp = 0. 
+
+      IF((TypeUpdate(2) == AGRIF_Update_average)
+     &                .AND. (coeffraf /= 1 ))THEN
+!---CDIR NEXPAND
+         IF(.NOT. precomputedone(2) ) Call average1Dprecompute2D
+     &      ( indmax(1)-indmin(1)+1,
+     &        indmax(2)-indmin(2)+1,
+     &        petab_child(2)-pttab_child(2)+1,
+     &        s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+!---CDIR NEXPAND
+          Call average1Daftercompute
+     &       (  tempP_trsp, tabtemp_trsp,
+     &          size(tempP_trsp), size(tabtemp_trsp),
+     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+
+      ELSEIF((TypeUpdate(2) == AGRIF_Update_copy)
+     &                .AND. (coeffraf /= 1 ))THEN
+!---CDIR NEXPAND
+         IF(.NOT. precomputedone(2) ) Call copy1Dprecompute2D
+     &      ( indmax(1)-indmin(1)+1,
+     &        indmax(2)-indmin(2)+1,
+     &        petab_child(2)-pttab_child(2)+1,
+     &        s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+!---CDIR NEXPAND
+          Call copy1Daftercompute
+     &       (  tempP_trsp, tabtemp_trsp,
+     &          size(tempP_trsp), size(tabtemp_trsp),
+     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+
+      ELSE
+
+      do i = indmin(1),indmax(1)
+C
+!---CDIR NEXPAND
+        Call Agrif_UpdateBase(TypeUpdate(2),
+     &           tempP_trsp(indmin(nbdim):indmax(nbdim),i),
+     &          tabtemp_trsp(pttab_child(nbdim):petab_child(nbdim),i),
+     &           indmin(nbdim),indmax(nbdim),
+     &           pttab_child(nbdim),petab_child(nbdim),
+     &           s_parent(nbdim),s_child(nbdim),
+     &           ds_parent(nbdim),ds_child(nbdim),
+     &                  coeffraf,locind_child_left)
+C        
+      enddo
+      
+      ENDIF
+
+      tempP = TRANSPOSE(tempP_trsp)
+C
+      Return
+C
+C
+      End Subroutine Agrif_Update_2D_recursive
+C
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Agrif_Update_3D_Recursive 
+C     **************************************************************************
+C
+      Subroutine Agrif_Update_3D_recursive(TypeUpdate,tempP,tempC,
+     &                                     indmin,indmax,   
+     &                                     pttab_child,petab_child,
+     &                                     s_child,s_parent,
+     &                                     ds_child,ds_parent,nbdim)
+C
+CCC   Description:
+CCC   Subroutine to update a 3D grid variable on the parent grid. 
+CCC   It calls Agrif_Update_2D_Recursive and Agrif_UpdateBase.   
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C     
+      INTEGER                   :: nbdim
+      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL, DIMENSION(nbdim)    :: s_child,s_parent
+      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
+      REAL, DIMENSION(indmin(1):indmax(1),
+     &                indmin(2):indmax(2),
+     &                indmin(3):indmax(3))           :: tempP
+      REAL, DIMENSION(pttab_child(1):petab_child(1),
+     &                pttab_child(2):petab_child(2),
+     &                pttab_child(3):petab_child(3)) :: tempC
+C
+C     Local variables      
+      REAL, DIMENSION(indmin(1):indmax(1),
+     &                 indmin(2):indmax(2), 
+     &                 pttab_child(3):petab_child(3)) :: tabtemp
+      INTEGER :: i,j,k
+      INTEGER :: coeffraf,locind_child_left
+      INTEGER :: kdeb
+C
+C
+      coeffraf = nint ( ds_parent(1) / ds_child(1) )
+      IF((TypeUpdate(1) == AGRIF_Update_average)
+     &                 .AND. (coeffraf /= 1 ))THEN
+!---CDIR NEXPAND
+         Call average1Dprecompute2D
+     &       (petab_child(2)-pttab_child(2)+1,
+     &        indmax(1)-indmin(1)+1,
+     &        petab_child(1)-pttab_child(1)+1,
+     &        s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+      precomputedone(1) = .TRUE.
+      ELSEIF((TypeUpdate(1) == AGRIF_Update_copy)
+     &                 .AND. (coeffraf /= 1 ))THEN
+!---CDIR NEXPAND
+         Call copy1Dprecompute2D
+     &       (petab_child(2)-pttab_child(2)+1,
+     &        indmax(1)-indmin(1)+1,
+     &        petab_child(1)-pttab_child(1)+1,
+     &        s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+      precomputedone(1) = .TRUE.
+      ENDIF
+
+      coeffraf = nint ( ds_parent(2) / ds_child(2) )
+      IF((TypeUpdate(2) == AGRIF_Update_average)
+     &                .AND. (coeffraf /= 1 ))THEN
+!---CDIR NEXPAND
+         Call average1Dprecompute2D
+     &      ( indmax(1)-indmin(1)+1,
+     &        indmax(2)-indmin(2)+1,
+     &        petab_child(2)-pttab_child(2)+1,
+     &        s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+      precomputedone(2) = .TRUE.
+      ELSEIF((TypeUpdate(2) == AGRIF_Update_copy)
+     &                .AND. (coeffraf /= 1 ))THEN
+!---CDIR NEXPAND
+         Call copy1Dprecompute2D
+     &      ( indmax(1)-indmin(1)+1,
+     &        indmax(2)-indmin(2)+1,
+     &        petab_child(2)-pttab_child(2)+1,
+     &        s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+      precomputedone(2) = .TRUE.
+      ENDIF
+
+
+      do k = pttab_child(nbdim),petab_child(nbdim)
+C
+        Call Agrif_Update_2D_recursive(TypeUpdate(1:nbdim-1),    
+     &         tabtemp(:,:,k),
+     &         tempC(:,:,k),
+     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
+     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
+     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
+     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
+C
+      enddo
+C
+      precomputedone(1) = .FALSE.
+      precomputedone(2) = .FALSE.
+      coeffraf = nint ( ds_parent(3) / ds_child(3) )
+
+      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
+     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
+      
+      IF (coeffraf == 1) THEN
+      
+      kdeb = pttab_child(3)+locind_child_left-2
+      do k=indmin(3),indmax(3)
+      kdeb = kdeb + 1
+      do j = indmin(2),indmax(2)
+        do i = indmin(1),indmax(1)
+        tempP(i,j,k) = tabtemp(i,j,kdeb)
+      enddo
+      enddo
+      enddo
+              
+      ELSE
+      tempP = 0.
+C
+      do j = indmin(2),indmax(2)
+C
+        do i = indmin(1),indmax(1)
+C
+          Call Agrif_UpdateBase(TypeUpdate(3),
+     &           tempP(i,j,:),
+     &          tabtemp(i,j,:),
+     &           indmin(nbdim),indmax(nbdim),
+     &           pttab_child(nbdim),petab_child(nbdim),
+     &           s_parent(nbdim),s_child(nbdim),
+     &           ds_parent(nbdim),ds_child(nbdim),
+     &                  coeffraf,locind_child_left)
+C
+        enddo 
+C        
+      enddo
+      ENDIF
+C
+      Return
+C
+C
+      End Subroutine Agrif_Update_3D_recursive
+C
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Agrif_Update_4D_Recursive 
+C     **************************************************************************
+C
+      Subroutine Agrif_Update_4D_recursive(TypeUpdate,tempP,tempC,
+     &                                     indmin,indmax,   
+     &                                     pttab_child,petab_child,
+     &                                     s_child,s_parent,
+     &                                     ds_child,ds_parent,nbdim)
+C
+CCC   Description:
+CCC   Subroutine to update a 4D grid variable on the parent grid. 
+CCC   It calls Agrif_Update_3D_Recursive and Agrif_UpdateBase.    
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C     
+      INTEGER                   :: nbdim
+      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL, DIMENSION(nbdim)    :: s_child,s_parent
+      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
+      REAL, DIMENSION(indmin(1):indmax(1),
+     &                indmin(2):indmax(2),
+     &                indmin(3):indmax(3),
+     &                indmin(4):indmax(4))           :: tempP
+      REAL, DIMENSION(pttab_child(1):petab_child(1),
+     &                pttab_child(2):petab_child(2),
+     &                pttab_child(3):petab_child(3),
+     &                pttab_child(4):petab_child(4)) :: tempC
+C
+C     Local variables      
+      REAL, DIMENSION(:,:,:,:), Allocatable :: tabtemp
+      INTEGER :: i,j,k,l
+      INTEGER :: coeffraf,locind_child_left
+C
+C
+      Allocate(tabtemp(indmin(1):indmax(1),
+     &                 indmin(2):indmax(2),
+     &                 indmin(3):indmax(3), 
+     &                 pttab_child(4):petab_child(4)))
+C
+      do l = pttab_child(nbdim),petab_child(nbdim)
+C
+        Call Agrif_Update_3D_recursive(TypeUpdate(1:nbdim-1),    
+     &         tabtemp(indmin(nbdim-3):indmax(nbdim-3),
+     &                 indmin(nbdim-2):indmax(nbdim-2),
+     &                 indmin(nbdim-1):indmax(nbdim-1),l),
+     &         tempC(pttab_child(nbdim-3):petab_child(nbdim-3),
+     &               pttab_child(nbdim-2):petab_child(nbdim-2),
+     &               pttab_child(nbdim-1):petab_child(nbdim-1),l),
+     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
+     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
+     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
+     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
+C
+      enddo
+      
+      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
+     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
+C
+      tempP = 0.
+
+      do k = indmin(3),indmax(3)
+C
+        do j = indmin(2),indmax(2)
+C
+          do i = indmin(1),indmax(1)
+C
+            Call Agrif_UpdateBase(TypeUpdate(4),
+     &           tempP(i,j,k,indmin(nbdim):indmax(nbdim)),
+     &          tabtemp(i,j,k,pttab_child(nbdim):petab_child(nbdim)),
+     &           indmin(nbdim),indmax(nbdim),
+     &           pttab_child(nbdim),petab_child(nbdim),
+     &           s_parent(nbdim),s_child(nbdim),
+     &           ds_parent(nbdim),ds_child(nbdim),
+     &                  coeffraf,locind_child_left)
+C
+          enddo 
+C
+        enddo 
+C        
+      enddo
+C
+      Deallocate(tabtemp)
+C
+      Return
+C
+C
+      End Subroutine Agrif_Update_4D_recursive
+C
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Agrif_Update_5D_Recursive 
+C     **************************************************************************
+C
+      Subroutine Agrif_Update_5D_recursive(TypeUpdate,tempP,tempC,
+     &                                     indmin,indmax,   
+     &                                     pttab_child,petab_child,
+     &                                     s_child,s_parent,
+     &                                     ds_child,ds_parent,nbdim)
+C
+CCC   Description:
+CCC   Subroutine to update a 5D grid variable on the parent grid. 
+CCC   It calls Agrif_Update_4D_Recursive and Agrif_UpdateBase.    
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C     
+      INTEGER                   :: nbdim
+      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL, DIMENSION(nbdim)    :: s_child,s_parent
+      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
+      REAL, DIMENSION(indmin(1):indmax(1),
+     &                indmin(2):indmax(2),
+     &                indmin(3):indmax(3),
+     &                indmin(4):indmax(4),
+     &                indmin(5):indmax(5))           :: tempP
+      REAL, DIMENSION(pttab_child(1):petab_child(1),
+     &                pttab_child(2):petab_child(2),
+     &                pttab_child(3):petab_child(3),
+     &                pttab_child(4):petab_child(4),
+     &                pttab_child(5):petab_child(5)) :: tempC
+C
+C     Local variables      
+      REAL, DIMENSION(:,:,:,:,:), Allocatable :: tabtemp
+      INTEGER :: i,j,k,l,m
+      INTEGER :: coeffraf,locind_child_left
+C
+C
+      Allocate(tabtemp(indmin(1):indmax(1),
+     &                 indmin(2):indmax(2),
+     &                 indmin(3):indmax(3),
+     &                 indmin(4):indmax(4),   
+     &                 pttab_child(5):petab_child(5)))
+C
+      do m = pttab_child(nbdim),petab_child(nbdim)
+C
+        Call Agrif_Update_4D_recursive(TypeUpdate(1:nbdim-1),    
+     &         tabtemp(indmin(nbdim-4):indmax(nbdim-4),
+     &                 indmin(nbdim-3):indmax(nbdim-3),
+     &                 indmin(nbdim-2):indmax(nbdim-2),
+     &                 indmin(nbdim-1):indmax(nbdim-1),m),
+     &         tempC(pttab_child(nbdim-4):petab_child(nbdim-4),
+     &               pttab_child(nbdim-3):petab_child(nbdim-3),
+     &               pttab_child(nbdim-2):petab_child(nbdim-2),
+     &               pttab_child(nbdim-1):petab_child(nbdim-1),m),
+     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
+     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
+     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
+     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
+C
+      enddo
+      
+      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
+     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
+      tempP = 0.
+C
+      do l = indmin(4),indmax(4)
+C
+        do k = indmin(3),indmax(3)
+C
+          do j = indmin(2),indmax(2)
+C
+            do i = indmin(1),indmax(1)
+C
+              Call Agrif_UpdateBase(TypeUpdate(5),
+     &           tempP(i,j,k,l,indmin(nbdim):indmax(nbdim)),
+     &          tabtemp(i,j,k,l,
+     &                   pttab_child(nbdim):petab_child(nbdim)),
+     &           indmin(nbdim),indmax(nbdim),
+     &           pttab_child(nbdim),petab_child(nbdim),
+     &           s_parent(nbdim),s_child(nbdim),
+     &           ds_parent(nbdim),ds_child(nbdim),
+     &                  coeffraf,locind_child_left)
+C
+            enddo
+C
+          enddo 
+C
+        enddo 
+C        
+      enddo
+C
+      Deallocate(tabtemp)
+C
+      Return
+C
+C
+      End Subroutine Agrif_Update_5D_recursive
+C
+C
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Agrif_Update_6D_Recursive 
+C     **************************************************************************
+C
+      Subroutine Agrif_Update_6D_recursive(TypeUpdate,tempP,tempC,
+     &                                     indmin,indmax,   
+     &                                     pttab_child,petab_child,
+     &                                     s_child,s_parent,
+     &                                     ds_child,ds_parent,nbdim)
+C
+CCC   Description:
+CCC   Subroutine to update a 6D grid variable on the parent grid. 
+CCC   It calls Agrif_Update_5D_Recursive and Agrif_UpdateBase.    
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C     
+      INTEGER                   :: nbdim
+      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL, DIMENSION(nbdim)    :: s_child,s_parent
+      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
+      REAL, DIMENSION(indmin(1):indmax(1),
+     &                indmin(2):indmax(2),
+     &                indmin(3):indmax(3),
+     &                indmin(4):indmax(4),
+     &                indmin(5):indmax(5),
+     &                indmin(6):indmax(6))           :: tempP
+      REAL, DIMENSION(pttab_child(1):petab_child(1),
+     &                pttab_child(2):petab_child(2),
+     &                pttab_child(3):petab_child(3),
+     &                pttab_child(4):petab_child(4),
+     &                pttab_child(5):petab_child(5),
+     &                pttab_child(6):petab_child(6)) :: tempC
+C
+C     Local variables      
+      REAL, DIMENSION(:,:,:,:,:,:), Allocatable :: tabtemp
+      INTEGER :: i,j,k,l,m,n
+      INTEGER :: coeffraf,locind_child_left
+C
+C
+      Allocate(tabtemp(indmin(1):indmax(1),
+     &                 indmin(2):indmax(2),
+     &                 indmin(3):indmax(3),
+     &                 indmin(4):indmax(4),   
+     &                 indmin(5):indmax(5),   
+     &                 pttab_child(6):petab_child(6)))
+C
+      do n = pttab_child(nbdim),petab_child(nbdim)
+C
+        Call Agrif_Update_5D_recursive(TypeUpdate(1:nbdim-1),    
+     &         tabtemp(indmin(nbdim-5):indmax(nbdim-5),
+     &                 indmin(nbdim-4):indmax(nbdim-4),
+     &                 indmin(nbdim-3):indmax(nbdim-3),
+     &                 indmin(nbdim-2):indmax(nbdim-2),
+     &                 indmin(nbdim-1):indmax(nbdim-1),n),
+     &         tempC(pttab_child(nbdim-5):petab_child(nbdim-5),
+     &               pttab_child(nbdim-4):petab_child(nbdim-4),
+     &               pttab_child(nbdim-3):petab_child(nbdim-3),
+     &               pttab_child(nbdim-2):petab_child(nbdim-2),
+     &               pttab_child(nbdim-1):petab_child(nbdim-1),n),
+     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
+     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
+     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
+     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
+C
+      enddo
+      
+      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
+     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
+C
+      tempP = 0.
+
+      do m = indmin(5),indmax(5)
+      do l = indmin(4),indmax(4)
+C
+        do k = indmin(3),indmax(3)
+C
+          do j = indmin(2),indmax(2)
+C
+            do i = indmin(1),indmax(1)
+C
+              Call Agrif_UpdateBase(TypeUpdate(6),
+     &           tempP(i,j,k,l,m,indmin(nbdim):indmax(nbdim)),
+     &          tabtemp(i,j,k,l,m,
+     &                   pttab_child(nbdim):petab_child(nbdim)),
+     &           indmin(nbdim),indmax(nbdim),
+     &           pttab_child(nbdim),petab_child(nbdim),
+     &           s_parent(nbdim),s_child(nbdim),
+     &           ds_parent(nbdim),ds_child(nbdim),
+     &                  coeffraf,locind_child_left)
+C
+            enddo
+C
+          enddo 
+C
+        enddo 
+C        
+      enddo
+      enddo
+C
+      Deallocate(tabtemp)
+C
+      Return
+C
+C
+      End Subroutine Agrif_Update_6D_recursive
+C
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Agrif_UpdateBase  
+C     **************************************************************************  
+C  
+      Subroutine Agrif_UpdateBase(TypeUpdate,
+     &                            parenttab,childtab,
+     &                            indmin,indmax,pttab_child,petab_child,
+     &                            s_parent,s_child,ds_parent,ds_child,
+     &                            coeffraf,locind_child_left)
+C
+CCC   Description:
+CCC   Subroutine calling the updating method chosen by the user (copy, average
+CCC   or full-weighting).    
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C
+      INTEGER :: TypeUpdate
+      INTEGER :: indmin,indmax
+      INTEGER :: pttab_child,petab_child
+      REAL,DIMENSION(indmin:indmax)           :: parenttab       
+      REAL,DIMENSION(pttab_child:petab_child) :: childtab      
+      REAL    :: s_parent,s_child
+      REAL    :: ds_parent,ds_child      
+      INTEGER :: coeffraf,locind_child_left
+C
+C
+      if (TypeUpdate == AGRIF_Update_copy) then
+C             
+          Call agrif_copy1D
+     &       (parenttab,childtab,
+     &          indmax-indmin+1,petab_child-pttab_child+1,
+     &          s_parent,s_child,ds_parent,ds_child)     
+C
+        elseif (TypeUpdate == AGRIF_Update_average) then
+C           
+          Call average1D
+     &       (parenttab,childtab,
+     &          indmax-indmin+1,petab_child-pttab_child+1,
+     &          s_parent,s_child,ds_parent,ds_child) 
+C
+        elseif (TypeUpdate == AGRIF_Update_full_weighting) then
+C             
+          Call full_weighting1D
+     &       (parenttab,childtab,
+     &          indmax-indmin+1,petab_child-pttab_child+1,
+     &          s_parent,s_child,ds_parent,ds_child,
+     &          coeffraf,locind_child_left)
+C
+      endif 
+C
+      Return                
+C
+C      
+      End Subroutine Agrif_UpdateBase
+C
+C
+
+      Subroutine Agrif_Compute_nbdim_update(s_parent,s_child,
+     &  ds_parent,ds_child,coeffraf,locind_child_left)
+      real :: s_parent,s_child,ds_parent,ds_child
+      integer :: coeffraf,locind_child_left
+     
+      coeffraf = nint(ds_parent/ds_child)
+      locind_child_left = 1 + agrif_int((s_parent-s_child)/ds_child)
+      
+      End Subroutine Agrif_Compute_nbdim_update
+ 
+#if defined key_mpp_mpi      
+      Subroutine Agrif_Find_list_update(list_update,pttab,petab,
+     &                          pttab_Child,pttab_Parent,nbdim,
+     &     find_list_update,tab4t,tab5t,memberinall,memberinall2,
+     &     sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2)     
+      TYPE(Agrif_List_Interp_Loc), Pointer :: list_update
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim)   :: pttab,petab,pttab_Child,pttab_Parent
+      LOGICAL :: find_list_update
+      Type(Agrif_List_Interp_loc), Pointer :: parcours
+      INTEGER :: i
+C
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab5t      
+      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall,memberinall2
+      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1      
+      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc2,recvfromproc2      
+                    
+      find_list_update = .FALSE.
+      
+      parcours => list_update
+      
+      Find_loop :   Do While (associated(parcours))
+        Do i=1,nbdim
+          IF ((pttab(i) /= parcours%interp_loc%pttab(i)).OR.
+     &        (petab(i) /= parcours%interp_loc%petab(i)).OR.
+     &        (pttab_child(i) /= parcours%interp_loc%pttab_child(i)).OR.
+     &        (pttab_parent(i) /= parcours%interp_loc%pttab_parent(i)))
+     &               THEN
+            parcours=>parcours%suiv
+            Cycle Find_loop
+          ENDIF
+        EndDo
+        
+        tab4t = parcours%interp_loc%tab4t(1:nbdim,0:Agrif_Nbprocs-1,1:8)
+        memberinall = parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1)
+        
+        tab5t = parcours%interp_loc%tab5t(1:nbdim,0:Agrif_Nbprocs-1,1:8)
+        memberinall2 = 
+     &       parcours%interp_loc%memberinall2(0:Agrif_Nbprocs-1)
+        sendtoproc1 = 
+     &       parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1)   
+        recvfromproc1 = 
+     &       parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1)     
+        sendtoproc2 = 
+     &       parcours%interp_loc%sendtoproc2(0:Agrif_Nbprocs-1)   
+        recvfromproc2 = 
+     &       parcours%interp_loc%recvfromproc2(0:Agrif_Nbprocs-1)          
+        
+        find_list_update = .TRUE.   
+        Exit Find_loop
+      End Do Find_loop  
+                              
+      End Subroutine Agrif_Find_list_update  
+      
+      Subroutine Agrif_AddTo_list_update(list_update,pttab,petab,
+     &                          pttab_Child,pttab_Parent,nbdim
+     &      ,tab4t,tab5t,memberinall,memberinall2,
+     &      sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2)
+          
+      TYPE(Agrif_List_Interp_Loc), Pointer :: list_update
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim)   :: pttab,petab,pttab_Child,pttab_Parent
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab5t      
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: memberinall, memberinall2
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1, recvfromproc1      
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc2, recvfromproc2
+
+      Type(Agrif_List_Interp_loc), Pointer :: parcours
+            
+       Allocate(parcours)
+      Allocate(parcours%interp_loc)
+      
+      parcours%interp_loc%pttab(1:nbdim) = pttab(1:nbdim)
+      parcours%interp_loc%petab(1:nbdim) = petab(1:nbdim)
+      parcours%interp_loc%pttab_child(1:nbdim) = pttab_child(1:nbdim)
+      parcours%interp_loc%pttab_parent(1:nbdim) = pttab_parent(1:nbdim)
+      Allocate(parcours%interp_loc%tab4t(nbdim,0:Agrif_Nbprocs-1,8))
+      Allocate(parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1))
+      
+      Allocate(parcours%interp_loc%tab5t(nbdim,0:Agrif_Nbprocs-1,8))
+      Allocate(parcours%interp_loc%memberinall2(0:Agrif_Nbprocs-1))
+      Allocate(parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1))
+      Allocate(parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1))      
+      Allocate(parcours%interp_loc%sendtoproc2(0:Agrif_Nbprocs-1))
+      Allocate(parcours%interp_loc%recvfromproc2(0:Agrif_Nbprocs-1))            
+            
+      parcours%interp_loc%tab4t=tab4t   
+      parcours%interp_loc%memberinall=memberinall
+ 
+      parcours%interp_loc%tab5t=tab5t   
+      parcours%interp_loc%memberinall2=memberinall2
+      parcours%interp_loc%sendtoproc1=sendtoproc1   
+      parcours%interp_loc%recvfromproc1=recvfromproc1      
+      parcours%interp_loc%sendtoproc2=sendtoproc2       
+      parcours%interp_loc%recvfromproc2=recvfromproc2      
+            
+      parcours%suiv => list_update
+      
+      list_update => parcours
+      
+      End Subroutine Agrif_Addto_list_update
+#endif
+           
+
+C     **************************************************************************
+CCC   Subroutine Agrif_Update_1D_Recursive
+C     **************************************************************************
+C
+      Subroutine Agrif_Update_1D_recursive(TypeUpdate,tempP,tempC,
+     &                                     indmin,indmax,
+     &                                     pttab_child,petab_child,
+     &                                     s_child,s_parent,
+     &                                     ds_child,ds_parent,nbdim)
+C
+CCC   Description:
+CCC   Subroutine to update a 1D grid variable on the parent grid.
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C
+C     Arguments
+      INTEGER                   :: nbdim
+      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL, DIMENSION(nbdim)    :: s_child,s_parent
+      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
+      REAL, DIMENSION(indmin(nbdim):indmax(nbdim))           :: tempP
+      REAL, DIMENSION(pttab_child(nbdim):petab_child(nbdim)) :: tempC
+      INTEGER :: coeffraf,locind_child_left
+C
+C
+      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
+     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
+      
+      Call Agrif_UpdateBase(TypeUpdate(1),
+     &                  tempP(indmin(nbdim):indmax(nbdim)),
+     &                  tempC(pttab_child(nbdim):petab_child(nbdim)),
+     &                  indmin(nbdim),indmax(nbdim),           
+     &                  pttab_child(nbdim),petab_child(nbdim),
+     &                  s_parent(nbdim),s_child(nbdim),
+     &                  ds_parent(nbdim),ds_child(nbdim),
+     &                  coeffraf,locind_child_left)
+
+C
+      Return
+C
+C
+      End Subroutine Agrif_Update_1D_recursive      
+
+      End Module Agrif_Update
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdatebasic.F
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdatebasic.F	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdatebasic.F	(revision 8201)
@@ -0,0 +1,659 @@
+!
+! $Id: modupdatebasic.F 2715 2011-03-30 15:58:35Z rblod $
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place -  Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_Updatebasic
+C      
+C
+      Module Agrif_Updatebasic
+C
+CCC   Description:
+CCC   Module containing different procedures of update (copy,average,
+CCC   full_weighting) used in the Agrif_Update module.
+C
+C     Modules used:
+C
+      USE Agrif_types
+      
+      IMPLICIT NONE
+      
+      integer,dimension(:,:),allocatable :: indchildcopy
+      integer,dimension(:,:),allocatable :: indchildaverage
+C             
+
+      CONTAINS
+C     Define procedures contained in this module
+C
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Copy1d  
+C     ************************************************************************** 
+C
+      Subroutine agrif_copy1d(x,y,np,nc,
+     &                  s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to do a copy on a parent grid (vector x) from its child grid 
+CCC   (vector y).  
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C        
+C     Arguments
+      INTEGER             :: np,nc      
+      REAL, DIMENSION(np) :: x      
+      REAL, DIMENSION(nc) :: y  
+      REAL                :: s_parent,s_child
+      REAL                :: ds_parent,ds_child
+C
+C     Local variables
+      INTEGER :: i,locind_child_left,coeffraf
+C 
+C
+      coeffraf = nint(ds_parent/ds_child)
+C
+      if (coeffraf == 1) then
+C
+          locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
+C        
+!CDIR ALTCODE
+          x(1:np) = y(locind_child_left:locind_child_left+np-1)
+C
+          return
+C
+      endif
+C
+      
+      locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
+      
+!CDIR ALTCODE
+      do i = 1,np
+C      
+         x(i) = y(locind_child_left)
+C
+         locind_child_left = locind_child_left + coeffraf
+C         
+      enddo    
+       
+C
+      Return 
+C
+C
+      End Subroutine agrif_copy1d
+
+C     **************************************************************************  
+CCC   Subroutine Copy1dprecompute  
+C     ************************************************************************** 
+C
+      Subroutine copy1dprecompute2d(nc2,np,nc,
+     &                  s_parent,s_child,ds_parent,ds_child,dir)
+C
+CCC   Description:
+CCC   Subroutine to precompute index for a copy on a parent grid (vector x) from
+CCC   its child grid (vector y).
+C
+CC    Method:
+C
+C     Declarations:
+C
+
+C        
+C     Arguments
+      INTEGER             :: nc2,np,nc
+      INTEGER             :: dir   
+      REAL                :: s_parent,s_child
+      REAL                :: ds_parent,ds_child
+C
+C     Local variables
+      INTEGER,DIMENSION(:,:),ALLOCATABLE :: indchildcopy_tmp
+      INTEGER :: i,locind_child_left,coeffraf
+C 
+C
+      coeffraf = nint(ds_parent/ds_child)
+C
+      locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
+
+      if (.not.allocated(indchildcopy)) then
+      allocate(indchildcopy(np*nc2,3))
+      else
+      if (size(indchildcopy,1)<np*nc2) then
+      allocate( indchildcopy_tmp(
+     &         size(indchildcopy,1),size(indchildcopy,2)))
+      indchildcopy_tmp = indchildcopy
+      deallocate(indchildcopy)
+      allocate(indchildcopy(np*nc2,3))
+      indchildcopy(1:size(indchildcopy_tmp,1),
+     &              1:size(indchildcopy_tmp,2)) = indchildcopy_tmp
+      deallocate(indchildcopy_tmp)
+      endif
+      endif
+
+
+      do i = 1,np
+C      
+         indchildcopy(i,dir) = locind_child_left
+         locind_child_left = locind_child_left + coeffraf
+C         
+      enddo
+
+      do i =2, nc2
+        indchildcopy(1+(i-1)*np:i*np,dir)=
+     &       indchildcopy(1+(i-2)*np:(i-1)*np,dir) + nc 
+      enddo
+
+C
+      Return
+C
+C
+      End Subroutine copy1dprecompute2d
+
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Copy1dprecompute  
+C     ************************************************************************** 
+C
+      Subroutine copy1dprecompute(np,nc,
+     &                  s_parent,s_child,ds_parent,ds_child,dir)
+C
+CCC   Description:
+CCC   Subroutine to precompute index for a copy on a parent grid (vector x) from
+CCC   its child grid (vector y).
+C
+CC    Method:
+C
+C     Declarations:
+C
+
+C        
+C     Arguments
+      INTEGER             :: np,nc
+      INTEGER             :: dir
+      REAL                :: s_parent,s_child
+      REAL                :: ds_parent,ds_child
+C
+C     Local variables
+      INTEGER :: i,locind_child_left,coeffraf
+C 
+C
+      coeffraf = nint(ds_parent/ds_child)
+C
+      locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
+
+      if (.not.allocated(indchildcopy)) then
+      allocate(indchildcopy(np,1))
+      else
+      if (size(indchildcopy)<np) then
+      deallocate(indchildcopy)
+      allocate(indchildcopy(np,1))
+      endif
+      endif
+
+!CDIR ALTCODE
+      do i = 1,np
+C      
+         indchildcopy(i,1) = locind_child_left
+         locind_child_left = locind_child_left + coeffraf
+C         
+      enddo
+
+C
+      Return
+C
+C
+      End Subroutine copy1dprecompute
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Copy1daftercompute  
+C     ************************************************************************** 
+C
+      Subroutine copy1daftercompute(x,y,np,nc,
+     &                  s_parent,s_child,ds_parent,ds_child,dir)
+C
+CCC   Description:
+CCC   Subroutine to do a copy on a parent grid (vector x) from its child grid 
+CCC   (vector y) using precomputed index.  
+C
+CC    Method:
+C
+C     Declarations:
+C
+  
+C        
+C     Arguments
+      INTEGER             :: np,nc
+      INTEGER             :: dir
+      REAL, DIMENSION(np) :: x
+      REAL, DIMENSION(nc) :: y
+      REAL                :: s_parent,s_child
+      REAL                :: ds_parent,ds_child
+C
+C     Local variables
+      INTEGER :: i
+C 
+C
+      
+!CDIR ALTCODE
+      do i = 1,np
+C      
+         x(i) = y(indchildcopy(i,dir))
+C
+      enddo
+  
+C
+      Return
+C
+C
+      End Subroutine copy1daftercompute
+
+
+C
+C     **************************************************************************  
+CCC   Subroutine Average1d  
+C     ************************************************************************** 
+C   
+      Subroutine average1d(x,y,np,nc,
+     &                     s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to do an update by average on a parent grid (vector x)from its 
+CCC   child grid (vector y).
+C
+C     Arguments
+      INTEGER             :: np,nc      
+      REAL, DIMENSION(np) :: x      
+      REAL, DIMENSION(nc) :: y  
+      REAL                :: s_parent,s_child
+      REAL                :: ds_parent,ds_child
+C
+C     Local variables
+      INTEGER :: i,locind_child_left,coeffraf,ii
+      REAL    :: xpos, invcoeffraf 
+      INTEGER :: nbnonnuls
+      INTEGER :: diffmod
+C 
+C
+      coeffraf = nint(ds_parent/ds_child)
+      invcoeffraf = 1./coeffraf
+C
+      if (coeffraf == 1) then
+C
+          locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
+C        
+          x(1:np) = y(locind_child_left:locind_child_left+np-1)
+C
+          return
+C
+      endif
+C
+      xpos = s_parent      
+      
+      x = 0.
+C
+      diffmod = 0
+      
+      IF ( mod(coeffraf,2) == 0 ) diffmod = 1
+
+        locind_child_left = 1 + agrif_int((xpos - s_child)/ds_child)
+C
+      IF (Agrif_UseSpecialValueInUpdate) THEN
+
+      do i = 1,np
+          nbnonnuls = 0
+!CDIR NOVECTOR
+          Do ii = -coeffraf/2+locind_child_left+diffmod,
+     &                coeffraf/2+locind_child_left
+C 
+               IF (y(ii) .NE. Agrif_SpecialValueFineGrid) THEN
+               nbnonnuls = nbnonnuls + 1
+               x(i) = x(i) + y(ii)
+               ENDIF
+          End Do
+               IF (nbnonnuls .NE. 0) THEN
+                  x(i) = x(i)/nbnonnuls
+               ELSE
+                  x(i) = Agrif_SpecialValueFineGrid
+               ENDIF
+        locind_child_left = locind_child_left + coeffraf
+      enddo
+
+      ELSE 
+
+!CDIR ALTCODE
+      do i = 1,np
+!CDIR NOVECTOR
+          Do ii = -coeffraf/2+locind_child_left+diffmod,
+     &                coeffraf/2+locind_child_left
+C 
+               x(i) = x(i) + y(ii)
+          End Do
+                 x(i) = x(i)*invcoeffraf
+        locind_child_left = locind_child_left + coeffraf
+      enddo
+
+      ENDIF
+
+      Return 
+C            
+C     
+      End Subroutine average1d
+      
+      Subroutine average1dprecompute2d(nc2,np,nc,
+     &                     s_parent,s_child,ds_parent,ds_child,dir)
+C
+CCC   Description:
+CCC   Subroutine to do an update by average on a parent grid (vector x)from its 
+CCC   child grid (vector y).
+C
+C     Arguments
+      INTEGER             :: nc2,np,nc,dir
+      REAL                :: s_parent,s_child
+      REAL                :: ds_parent,ds_child
+C
+C     Local variables
+      INTEGER :: i,locind_child_left,coeffraf,ii
+      INTEGER,DIMENSION(:,:),ALLOCATABLE :: indchildaverage_tmp
+      REAL    :: xpos, invcoeffraf
+      INTEGER :: nbnonnuls
+      INTEGER :: diffmod
+C 
+C
+      coeffraf = nint(ds_parent/ds_child)
+C
+      xpos = s_parent
+C
+      diffmod = 0
+
+      IF ( mod(coeffraf,2) == 0 ) diffmod = 1
+
+      locind_child_left = 1 + agrif_int((xpos - s_child)/ds_child)
+
+      if (.not.allocated(indchildaverage)) then
+      allocate(indchildaverage(np*nc2,3))
+      else
+      if (size(indchildaverage,1)<np*nc2) then
+      allocate( indchildaverage_tmp(
+     &         size(indchildaverage,1),size(indchildaverage,2)))
+      indchildaverage_tmp = indchildaverage
+      deallocate(indchildaverage)
+      allocate(indchildaverage(np*nc2,3))
+      indchildaverage(1:size(indchildaverage_tmp,1),
+     &              1:size(indchildaverage_tmp,2)) = indchildaverage_tmp
+      deallocate(indchildaverage_tmp)
+      endif
+      endif
+
+      do i = 1,np
+        indchildaverage(i,dir)= -coeffraf/2+locind_child_left
+     &                                    +diffmod
+        locind_child_left = locind_child_left + coeffraf
+      enddo
+      do i = 2,nc2
+        indchildaverage(1+(i-1)*np:i*np,dir)= 
+     &                 indchildaverage(1+(i-2)*np:(i-1)*np,dir) + nc 
+      enddo
+
+      Return 
+C            
+C     
+      End Subroutine average1dprecompute2d
+      
+
+      Subroutine average1dprecompute(np,nc,
+     &                     s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to do an update by average on a parent grid (vector x)from its 
+CCC   child grid (vector y).
+C
+C     Arguments
+      INTEGER             :: np,nc 
+      REAL                :: s_parent,s_child
+      REAL                :: ds_parent,ds_child
+C
+C     Local variables
+      INTEGER :: i,locind_child_left,coeffraf,ii
+      REAL    :: xpos, invcoeffraf 
+      INTEGER :: nbnonnuls
+      INTEGER :: diffmod
+C 
+C
+      coeffraf = nint(ds_parent/ds_child)
+
+C
+      if (coeffraf == 1) then
+C
+          return
+C
+      endif
+            
+C
+      xpos = s_parent
+C
+      diffmod = 0
+      
+      IF ( mod(coeffraf,2) == 0 ) diffmod = 1
+
+        locind_child_left = 1 + agrif_int((xpos - s_child)/ds_child)
+
+      if (.not.allocated(indchildaverage)) then
+      allocate(indchildaverage(np,1))
+      else
+      if (size(indchildaverage,1)<np) then
+      deallocate(indchildaverage)
+      allocate(indchildaverage(np,1))
+      endif
+      endif
+      
+!CDIR ALTCODE
+      do i = 1,np
+C 
+        indchildaverage(i,1)=-coeffraf/2+locind_child_left+diffmod
+        locind_child_left = locind_child_left + coeffraf
+      enddo
+
+      Return 
+C            
+C     
+      End Subroutine average1dprecompute
+      
+      Subroutine average1daftercompute(x,y,np,nc,
+     &                     s_parent,s_child,ds_parent,ds_child,dir) 
+C
+CCC   Description:
+CCC   Subroutine to do an update by average on a parent grid (vector x)from its 
+CCC   child grid (vector y).
+C
+C     Arguments
+      INTEGER             :: np,nc,dir      
+      REAL, DIMENSION(np) :: x      
+      REAL, DIMENSION(nc) :: y  
+      REAL                :: s_parent,s_child
+      REAL                :: ds_parent,ds_child
+C
+C     Local variables
+      INTEGER :: i,locind_child_left,coeffraf,ii,j
+      REAL    :: xpos, invcoeffraf 
+      REAL, PARAMETER :: one_third=1./3.
+      INTEGER, DIMENSION(np) :: nbnonnuls
+      INTEGER :: diffmod
+      REAL, DIMENSION(0:5) :: invcoeff=(/1.,1.,0.5,one_third,0.25,0.2/)
+C 
+C
+      coeffraf = nint(ds_parent/ds_child)
+      invcoeffraf = 1./coeffraf      
+C      
+C
+      IF (Agrif_UseSpecialValueInUpdate) THEN
+
+      nbnonnuls = 0
+      do  j =1, coeffraf
+          do i=1, np
+               IF (y(indchildaverage(i,dir) + j -1) .NE. 
+     &               Agrif_SpecialValueFineGrid) THEN
+               nbnonnuls(i) = nbnonnuls(i) + 1
+               x(i) = x(i) +  y(indchildaverage(i,dir) + j -1 )
+               ENDIF
+          End Do
+      enddo
+      do i=1,np
+      x(i)= x(i)*invcoeff(nbnonnuls(i)) 
+      enddo
+
+      ELSE
+!CDIR NOLOOPCHG
+      do  j =1, coeffraf
+!CDIR VECTOR
+          do i=1, np
+             x(i) = x(i) + y(indchildaverage(i,dir) + j -1 )
+          enddo
+      enddo
+       x = x * invcoeffraf
+      ENDIF
+
+      Return 
+C            
+C     
+      End Subroutine average1daftercompute            
+C
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Full_weighting1d  
+C     **************************************************************************  
+C
+      Subroutine full_weighting1D(x,y,np,nc,
+     &                            s_parent,s_child,ds_parent,ds_child,
+     &                            coeffraf,locind_child_left) 
+C
+CCC   Description:
+CCC   Subroutine to do an update by full_weighting on a parent grid (vector x) 
+CCC   from its child grid (vector y).
+C 
+C     Arguments
+      INTEGER             :: np,nc      
+      REAL, DIMENSION(np) :: x      
+      REAL, DIMENSION(nc) :: y  
+      REAL                :: s_parent,s_child
+      REAL                :: ds_parent,ds_child
+C
+C     Local variables
+      INTEGER :: i,locind_child_left,coeffraf
+      REAL    :: xpos,sumweight,weight
+      INTEGER :: ii,diffmod
+      REAL :: xposfin
+      INTEGER :: it1,it2
+      INTEGER :: i1,i2
+      REAL :: invsumweight
+      REAL :: weights(-(coeffraf):coeffraf)
+      
+C
+C
+      if (coeffraf == 1) then
+C        
+          x(1:np) = y(locind_child_left:locind_child_left+np-1)
+C
+          return
+C
+      endif
+C
+      xpos = s_parent      
+      
+       x = 0.
+
+       xposfin = s_child + ds_child * (locind_child_left - 1)
+       IF (abs(xposfin - xpos).LT.0.001) THEN
+          diffmod = 0
+       ELSE
+          diffmod = 1
+       ENDIF
+C
+             
+      if (diffmod == 1) THEN
+        invsumweight=1./(2.*coeffraf**2)
+        do i=-coeffraf,-1
+          weights(i) = invsumweight*(2*(coeffraf+i)+1)
+        enddo
+        do i=0,coeffraf-1
+          weights(i)=weights(-(i+1))
+        enddo
+        it1 = -coeffraf
+        i1 = -(coeffraf-1)+locind_child_left
+        i2 = 2*coeffraf - 1
+      else
+      invsumweight=1./coeffraf**2
+      do i=-(coeffraf-1),0
+        weights(i) = invsumweight*(coeffraf + i)
+      enddo
+      do i=1,coeffraf-1
+        weights(i) = invsumweight*(coeffraf - i)
+      enddo
+        it1 = -(coeffraf-1)
+        i1 = -(coeffraf-1)+locind_child_left
+        i2 = 2*coeffraf - 2
+      endif
+
+      sumweight = 0                    
+      do i = 1,np
+C
+          it2 = it1
+          Do ii = i1,i1+i2
+C
+           IF (Agrif_UseSpecialValueInUpdate) THEN
+            IF (y(ii) .NE. Agrif_SpecialValueFineGrid) THEN
+               x(i) = x(i) + weights(it2)*y(ii)
+               sumweight = sumweight+weights(it2)
+            ENDIF
+           ELSE           
+               x(i) = x(i) + weights(it2)*y(ii)
+           ENDIF           
+           
+          it2 = it2+1
+          End Do
+
+           IF (Agrif_UseSpecialValueInUpdate) THEN          
+                 IF (sumweight .NE. 0.) THEN
+                    x(i) = x(i)/sumweight
+                    sumweight = 0
+                 ELSE
+                    x(i) = Agrif_SpecialValueFineGrid
+                 ENDIF
+           ENDIF
+        
+        i1 = i1 + coeffraf
+C
+      enddo    
+C
+
+      Return 
+C            
+C
+      End Subroutine full_weighting1D 
+
+C
+      End module AGRIF_updatebasic
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F	(revision 8201)
@@ -0,0 +1,864 @@
+!
+! $Id: modutil.F 2731 2011-04-08 12:05:35Z rblod $
+!
+C     Agrif (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place-  Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_Util 
+C 
+      Module Agrif_Util 
+C
+C
+CCC   Description:   
+CCC   This module contains the two procedures called in the main program : 
+CCC   Agrif_Init_Grids allowing the initialization of the root coarse grid, and
+CCC   Agrif_Step allowing the creation of the grid hierarchy and the management
+CCC   of the time integration. 
+C
+C     Modules used:
+C
+      Use Agrif_Clustering    
+      Use Agrif_bcfunction
+C      
+      IMPLICIT NONE
+C
+      Contains
+C     Definition of procedures contained in this module.
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Step
+C     **************************************************************************
+C 
+      Subroutine Agrif_Step(procname) 
+C
+CCC   Description:
+CCC   Subroutine to create the grid hierarchy and to manage the time integration 
+CCC   procedure. It is called in the main program.
+C
+CC    Method:
+CC    Call on subroutines Agrif_Regrid and Agrif_Integrate.
+C
+C     Declarations:
+C
+      Optional :: procname
+      External :: procname
+C
+#ifdef key_mpp_mpi
+      INCLUDE 'mpif.h'
+      Integer      :: code, ierr
+      Logical      :: mpi_was_called
+C
+C
+      Call Agrif_comm_def(MPI_COMM_AGRIF)
+
+      CALL mpi_initialized ( mpi_was_called, code )
+      IF( code /= MPI_SUCCESS ) THEN
+         WRITE(*, *) ': Error in routine mpi_initialized'
+         CALL mpi_abort( mpi_comm_world, code, ierr )
+      ENDIF
+
+      IF( .NOT. mpi_was_called ) THEN
+         CALL mpi_comm_dup( mpi_comm_world, MPI_COMM_AGRIF, code)
+         IF( code /= MPI_SUCCESS ) THEN
+            WRITE(*, *) ' Agrif_Step: Error in routine mpi_comm_dup'
+            CALL mpi_abort( mpi_comm_world, code, ierr )
+         ENDIF
+      ENDIF
+
+      If (Agrif_Mygrid % ngridstep == 0) Then
+          Call MPI_COMM_SIZE(MPI_COMM_AGRIF,Agrif_Nbprocs,code)
+          Call MPI_COMM_RANK(MPI_COMM_AGRIF,Agrif_ProcRank,code)
+          Call MPI_COMM_GROUP(MPI_COMM_AGRIF,Agrif_Group,code)
+      endif
+#endif
+C
+C     Creation and initialization of the grid hierarchy 
+C
+C  
+C    Set the clustering variables
+C
+      Call Agrif_clustering_def()
+C      
+      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 1 ) then
+C     
+         If (Agrif_Mygrid % ngridstep == 0) then
+C
+            Call Agrif_Regrid
+C 
+            Call Agrif_Instance           
+     &          (Agrif_Mygrid)           
+         endif
+C
+      else
+C    
+         If (mod(Agrif_Mygrid % ngridstep, Agrif_Regridding) == 0) then
+C
+            Call Agrif_Regrid
+C  
+            Call Agrif_Instance           
+     &          (Agrif_Mygrid)  
+C            
+         endif
+C
+      endif
+C
+C     Time integration of the grid hierarchy
+C
+      If (present(procname)) Then
+         Call Agrif_Integrate (Agrif_Mygrid,procname)
+      Else
+         Call Agrif_Integrate (Agrif_Mygrid)      
+      endif
+C    
+      If (associated(Agrif_Mygrid%child_grids)) 
+     &   Call Agrif_Instance (Agrif_Mygrid)
+C
+      Return
+C             
+      End Subroutine Agrif_Step      
+
+C     **************************************************************************
+CCC   Subroutine Agrif_Step_Child
+C     **************************************************************************
+C
+      Subroutine Agrif_Step_Child(procname)
+C
+CCC   Description:
+CCC   Subroutine to create the grid hierarchy and to manage the time integration
+CCC   procedure. It is called in the main program.
+C
+CC    Method:
+CC    Call on subroutines Agrif_Regrid and Agrif_Integrate.
+C
+C     Declarations:
+C
+      Optional :: procname
+      External :: procname
+C
+C     Time integration of the grid hierarchy
+C
+      If (present(procname)) Then
+         Call Agrif_Integrate_Child (Agrif_Mygrid,procname)
+      Else
+         Call Agrif_Integrate_Child (Agrif_Mygrid)
+      endif
+C    
+      If (associated(Agrif_Mygrid%child_grids))
+     &   Call Agrif_Instance (Agrif_Mygrid)
+C
+      Return
+C
+      End Subroutine Agrif_Step_Child
+
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Regrid
+C     **************************************************************************
+C
+      Subroutine Agrif_Regrid
+C
+CCC   Description:
+CCC   Subroutine to create the grid hierarchy from fixed grids and 
+CC       adaptive mesh refinement.
+C
+CC    Method:        
+C
+C     Declarations:
+C
+C     Local variables      
+      Type(Agrif_Rectangle), Pointer     :: coarsegrid_fixed
+      Type(Agrif_Rectangle), Pointer     :: coarsegrid_moving  
+      INTEGER                            :: j
+      INTEGER :: nunit
+      INTEGER                            :: iii
+      Logical :: BEXIST
+C 
+      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 )
+     &   Call Agrif_detect_all(Agrif_Mygrid) ! Detection of areas to be refined
+C
+      Allocate(coarsegrid_fixed)
+      Allocate(coarsegrid_moving)
+C
+      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) 
+     &    Call Agrif_Cluster_All(Agrif_Mygrid,coarsegrid_moving) ! Clustering
+C
+      if ( Agrif_USE_FIXED_GRIDS .EQ. 1 .OR. 
+     &     Agrif_USE_ONLY_FIXED_GRIDS .EQ. 1 ) then
+C
+      If (Agrif_Mygrid % ngridstep == 0) Then
+          nunit = Agrif_Get_Unit()
+          open(nunit,file='AGRIF_FixedGrids.in',form='formatted',
+     &           status="old",ERR=99) ! Opening of the Agrif_FixedGrids.in file
+          j = 1
+C         Creation of the grid hierarchy from the Agrif_FixedGrids.in file 
+            do iii = 1 , Agrif_Probdim
+               coarsegrid_fixed % imin(iii) = 1
+               coarsegrid_fixed % imax(iii) = Agrif_Mygrid % nb(iii) + 1
+            enddo
+C      
+            Call Agrif_Read_Fix_Grd (coarsegrid_fixed,j,nunit)     
+            close(nunit) ! Closing of the Agrif_FixedGrids.in file 
+C
+          Nullify(Agrif_oldmygrid)
+          Nullify(Agrif_Mygrid  % child_grids)
+C        
+C         Creation of the grid hierarchy from coarsegrid_fixed
+            Call Agrif_Create_Grids (Agrif_Mygrid,coarsegrid_fixed)
+        Else        
+          Agrif_oldmygrid => Agrif_Mygrid % child_grids
+         endif
+      else
+      Agrif_oldmygrid => Agrif_Mygrid % child_grids
+      Nullify(Agrif_Mygrid  % child_grids)
+      endif
+C
+      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
+C
+      Call Agrif_Save_All(Agrif_oldmygrid)      
+C      
+      Call Agrif_Free_before_All(Agrif_oldmygrid)
+C 
+C     Creation of the grid hierarchy from coarsegrid_moving    
+      Call Agrif_Create_Grids
+     &     (Agrif_Mygrid,coarsegrid_moving)
+C
+      endif
+C
+C     Initialization of the grid hierarchy by copy or interpolation
+C
+      Call Agrif_Init_Hierarchy(Agrif_Mygrid)
+C
+      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) 
+     &        Call Agrif_Free_after_All(Agrif_oldmygrid)
+C
+      Deallocate(coarsegrid_fixed)
+      Deallocate(coarsegrid_moving)
+C      
+      Return
+C
+C     Opening error
+C
+   99 INQUIRE(FILE='AGRIF_FixedGrids.in',EXIST=BEXIST)
+      If (.not. BEXIST) Then
+          print*,'ERROR : File AGRIF_FixedGrids.in not found.'
+          STOP 
+        Else
+          print*,'Error opening file AGRIF_FixedGrids.in'
+          STOP         
+      endif     
+C      
+      End Subroutine Agrif_Regrid
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_detect_All
+C     **************************************************************************
+C
+      Recursive Subroutine Agrif_detect_all(g)
+C
+CCC   Description:
+CCC   Subroutine to detect areas to be refined.
+C
+CC    Method:        
+C
+C     Declarations:
+C
+      
+C      
+C     Pointer argument    
+      TYPE(Agrif_Grid) ,pointer  :: g        ! Pointer on the current grid
+C      
+C     Local variables
+      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive 
+                                             ! procedure      
+      INTEGER, DIMENSION(3)      :: size
+      INTEGER                    :: iii
+      Real :: g_eps     
+C
+      parcours => g % child_grids
+C  
+C     To be positioned on the finer grids of the grid hierarchy          
+C  
+      do while (associated(parcours))       
+         Call Agrif_detect_all (parcours % gr)  
+        parcours => parcours % next             
+      enddo
+C
+      g_eps = huge(1.)
+      do iii = 1 , Agrif_Probdim
+         g_eps=min(g_eps,g%Agrif_d(iii))
+      enddo
+C
+      g_eps = g_eps/100.
+C          
+      if ( Agrif_Probdim .EQ. 1 ) g%tabpoint1D=0
+      if ( Agrif_Probdim .EQ. 2 ) g%tabpoint2D=0
+      if ( Agrif_Probdim .EQ. 3 ) g%tabpoint3D=0
+C      
+      do iii = 1 , Agrif_Probdim
+         if (g%Agrif_d(iii)/Agrif_coeffref(iii).LT.
+     &                     (Agrif_mind(iii)-g_eps)) Return
+      enddo
+C                                       
+      Call Agrif_instance(g)
+C  
+C     Detection (Agrif_detect is a user s routine)
+C      
+     
+      do iii = 1 , Agrif_Probdim
+         size(iii) = g%nb(iii) + 1
+      enddo
+C
+      SELECT CASE (Agrif_Probdim)
+      CASE (1) 
+         Call Agrif_detect(g%tabpoint1D,size)
+      CASE (2) 
+         Call Agrif_detect(g%tabpoint2D,size)
+      CASE (3) 
+         Call Agrif_detect(g%tabpoint3D,size)
+      END SELECT
+C
+C     Addition of the areas detected on the child grids
+C      
+      parcours => g % child_grids 
+C           
+      Do while (associated(parcours))
+        Call Agrif_Add_detected_areas (g,parcours % gr)
+        parcours => parcours % next 
+      enddo
+C     
+      Return      
+C
+      End Subroutine Agrif_detect_all
+C      
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Add_detected_areas
+C     **************************************************************************
+C      
+      Subroutine Agrif_Add_detected_areas(parentgrid,childgrid)
+C
+CCC   Description:
+CCC   Subroutine to add on the parent grid the areas detected 
+CC       on its child grids.
+C
+CC    Method:        
+C
+C     Declarations:
+C
+      
+C 
+      Type(Agrif_Grid),pointer   :: parentgrid,childgrid
+C      
+      Integer :: i,j,k
+C
+      do i = 1,childgrid%nb(1)+1
+         if ( Agrif_Probdim .EQ. 1 ) then
+            If (childgrid%tabpoint1D(i).EQ.1) Then
+                parentgrid%tabpoint1D(childgrid%ix(1)+
+     &                 (i-1)/Agrif_Coeffref(1)) = 1
+            endif
+         else
+            do j=1,childgrid%nb(2)+1
+               if (Agrif_Probdim.EQ.2) then
+              If (childgrid%tabpoint2D(i,j).EQ.1) Then
+                  parentgrid%tabpoint2D(
+     &                  childgrid%ix(1)+(i-1)/Agrif_Coeffref(1),
+     &                  childgrid%ix(2)+(j-1)/Agrif_Coeffref(2)) = 1
+                  endif
+               else
+                  do k=1,childgrid%nb(3)+1
+                If (childgrid%tabpoint3D(i,j,k).EQ.1) Then
+                    parentgrid%tabpoint3D(
+     &                     childgrid%ix(1)+(i-1)/Agrif_Coeffref(1),
+     &                     childgrid%ix(2)+(j-1)/Agrif_Coeffref(2),
+     &                     childgrid%ix(3)+(k-1)/Agrif_Coeffref(3)) = 1
+                     endif
+                  enddo
+               endif
+            enddo
+         endif
+      enddo
+C      
+      Return
+C
+      End Subroutine Agrif_Add_detected_areas   
+C      
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Free_before_All
+C     **************************************************************************
+C
+      Recursive Subroutine Agrif_Free_before_All(g)
+C
+CCC   Description:
+C
+CC    Method:        
+C
+C     Declarations:
+C
+C     Pointer argument    
+      Type(Agrif_pgrid),pointer   :: g        ! Pointer on the current grid
+C
+C     Local pointer
+      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive 
+                                             ! procedure      
+C
+C
+      parcours => g        
+C      
+      Do while (associated(parcours))     
+        If (.not. parcours%gr%fixed) Then
+            Call Agrif_Free_data_before(parcours%gr)
+            parcours % gr % oldgrid = .TRUE.        
+        endif
+C
+        Call Agrif_Free_before_all (parcours % gr % child_grids)
+C  
+        parcours => parcours % next             
+      enddo
+C     
+      Return      
+C
+C
+      End Subroutine Agrif_Free_before_All
+C     **************************************************************************
+CCC   Subroutine Agrif_Save_All
+C     **************************************************************************
+C
+      Recursive Subroutine Agrif_Save_All(g)
+C
+CCC   Description:
+C
+CC    Method:        
+C
+C     Declarations:
+C
+C     Pointer argument    
+      Type(Agrif_pgrid),pointer   :: g        ! Pointer on the current grid
+C
+C     Local pointer
+      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive 
+                                             ! procedure      
+C
+C
+      parcours => g        
+C      
+      Do while (associated(parcours))     
+        If (.not. parcours%gr%fixed) Then
+            Call Agrif_Instance(parcours%gr)
+            Call Agrif_Before_Regridding()
+            parcours % gr % oldgrid = .TRUE.        
+        endif
+C
+        Call Agrif_Save_All (parcours % gr % child_grids)
+C  
+        parcours => parcours % next             
+      enddo
+C     
+      Return      
+C
+C
+      End Subroutine Agrif_Save_All      
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Free_after_All
+C     **************************************************************************
+C
+      Recursive Subroutine Agrif_Free_after_All(g)
+C
+CCC   Description:
+C
+CC    Method:        
+C
+C     Declarations:
+C
+      
+C      
+C     Pointer argument    
+      Type(Agrif_pgrid),pointer   :: g       ! Pointer on the current grid
+C
+C     Local pointers
+      TYPE(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive proced
+      Type(Agrif_pgrid),pointer  :: preparcours   
+      Type(Agrif_pgrid),pointer  :: preparcoursini 
+C
+C
+      Allocate(preparcours)
+C 
+      preparcoursini => preparcours
+C 
+      Nullify(preparcours % gr)
+C 
+      preparcours % next => g
+C
+      parcours => g
+C      
+      Do while (associated(parcours))
+C
+         if ( (.NOT. parcours% gr% fixed) .AND.
+     &        (parcours% gr% oldgrid    ) ) then
+          Call Agrif_Free_data_after(parcours%gr)
+         endif
+C
+         Call Agrif_Free_after_all (parcours % gr % child_grids)
+C
+      If (parcours % gr % oldgrid) Then
+          Deallocate(parcours % gr)
+          preparcours % next => parcours % next
+          Deallocate(parcours)
+          parcours => preparcours % next
+        Else
+          preparcours => preparcours % next
+          parcours => parcours % next 
+         endif       
+      enddo
+C
+      Deallocate(preparcoursini)
+C     
+      Return      
+C
+      End Subroutine Agrif_Free_after_All
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Integrate
+C     **************************************************************************
+C
+      Recursive Subroutine Agrif_Integrate(g, procname)         
+C
+CCC   Description:
+CCC   Subroutine to manage the time integration of the grid hierarchy.
+C
+CC    Method:
+CC    Recursive subroutine and call on subroutines Agrif_Instance & Agrif_Step
+C
+C     Declarations:
+C
+      
+C      
+C     Pointer argument    
+      Type(Agrif_Grid),pointer   :: g        ! Pointer on the current grid
+C
+C     main procedure name
+      Optional :: procname
+      External :: procname      
+C      
+C     Local pointer
+      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive 
+                                             ! procedure
+C
+C     Local scalars
+      INTEGER                    :: nbt      ! Number of time steps 
+                                             ! of the current grid
+      INTEGER                    :: k        
+      INTEGER                    :: iii
+C  
+C     Instanciation of the variables of the current grid
+      If (g%fixedrank .NE.0) Then      
+      Call Agrif_Instance
+     &     (g)
+      End If
+C       
+C     One step on the current grid      
+C
+      If (present(procname)) Then
+         Call procname ()      
+      Else
+        write(*,*) 'The name of the step subroutine has not '
+        write(*,*) 'been given in the subroutine Agrif_Integrate'
+        stop
+      endif
+C
+C     Number of time steps on the current grid      
+C
+      g%ngridstep = g % ngridstep + 1
+C      
+      parcours => g % child_grids
+C    
+C     Recursive procedure for the time integration of the grid hierarchy      
+      Do while (associated(parcours))
+C
+C       Instanciation of the variables of the current grid            
+        Call Agrif_Instance
+     &           (parcours % gr)
+C       
+C       Number of time steps
+        nbt = 1
+        do iii = 1 , Agrif_Probdim
+           nbt = max(nbt, parcours % gr % timeref(iii))
+        enddo
+C       
+        Do k = 1,nbt
+C       
+           If (present(procname)) Then
+                 Call Agrif_Integrate (parcours % gr, procname)
+           Else
+                 Call Agrif_Integrate (parcours % gr)      
+           endif
+C       
+        enddo     
+C  
+        parcours => parcours % next
+C     
+      enddo
+C
+C      
+      End Subroutine Agrif_Integrate 
+
+C     **************************************************************************
+CCC   Subroutine Agrif_Integrate_Child
+C     **************************************************************************
+C
+      Recursive Subroutine Agrif_Integrate_Child(g,procname)
+C
+CCC   Description:
+CCC   Subroutine to manage the time integration of the grid hierarchy.
+C
+CC    Method:
+CC    Recursive subroutine and call on subroutines Agrif_Instance & Agrif_Step.
+C
+C     Declarations:
+C
+
+C
+C     Pointer argument
+      Type(Agrif_Grid),pointer   :: g        ! Pointer on the current grid
+C
+C     main procedure name
+      Optional :: procname
+      External :: procname
+C
+C     Local pointer
+      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive
+                                             ! procedure
+C
+C     One step on the current grid
+C
+      If (present(procname)) Then
+         Call procname ()      
+      Else
+        write(*,*) 'The name of the step subroutine has not '
+        write(*,*) 'been given in the subroutine Agrif_Integrate'
+        stop
+      endif
+C
+C     Number of time steps on the current grid
+C
+C
+      parcours => g % child_grids
+C
+C     Recursive procedure for the time integration of the grid hierarchy      
+      Do while (associated(parcours))
+C
+C       Instanciation of the variables of the current grid
+        Call Agrif_Instance
+     &           (parcours % gr)
+
+C       
+           If (present(procname)) Then
+                 Call Agrif_Integrate_Child (parcours % gr, procname)
+           Else
+                 Call Agrif_Integrate_Child (parcours % gr)
+           endif
+C  
+        parcours => parcours % next
+C     
+      enddo
+C
+C
+      End Subroutine Agrif_Integrate_Child
+
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Init_Grids
+C     **************************************************************************
+C      
+      Subroutine Agrif_Init_Grids
+C
+CCC   Description:
+CCC   Subroutine to initialize the root coarse grid pointed by Agrif_Mygrid. 
+CCC   It is called in the main program.
+C
+C     Declarations:
+C
+C
+      INTEGER :: iii
+C
+C             definition of the probdim and modtypes variables
+C
+#ifdef key_mpp_mpi
+      INCLUDE 'mpif.h'
+      Agrif_MPIPREC = MPI_DOUBLE_PRECISION
+#endif
+      Call Agrif_probdim_modtype_def()
+C      
+      Agrif_UseSpecialValue = .FALSE.
+      Agrif_UseSpecialValueFineGrid = .FALSE.
+      Agrif_SpecialValue = 0.
+      Agrif_SpecialValueFineGrid = 0.
+C      
+C     Allocation of Agrif_Mygrid
+      allocate(Agrif_Mygrid)
+C      
+C     Space and time refinement factors are set to 1 on the root grid
+C
+      do iii = 1 , Agrif_Probdim
+         Agrif_Mygrid % spaceref(iii) = 1
+         Agrif_Mygrid % timeref(iii) = 1
+      enddo
+C      
+C     Initialization of the number of time steps    
+      Agrif_Mygrid % ngridstep = 0
+      Agrif_Mygrid % grid_id = 0
+C
+C     No parent grid for the root coarse grid
+      Nullify(Agrif_Mygrid % parent)
+C      
+C     Initialization of the minimum positions, global abscissa and space steps  
+      do iii= 1 ,  Agrif_Probdim
+         Agrif_Mygrid % ix(iii) = 1            
+         Agrif_Mygrid % Agrif_x(iii) = 0.
+         Agrif_Mygrid % Agrif_d(iii) = 1. 
+C     Borders of the root coarse grid 
+         Agrif_Mygrid % NearRootBorder(iii) = .true.  
+         Agrif_Mygrid % DistantRootBorder(iii) = .true.      
+      enddo
+C  
+C     The root coarse grid is a fixed grid
+      Agrif_Mygrid % fixed = .TRUE.
+C     Level of the root grid
+      Agrif_Mygrid % level = 0
+C     Maximum level in the hierarchy
+      Agrif_MaxLevelLoc = 0
+      
+C      
+C     Number of the grid pointed by Agrif_Mygrid (root coarse grid)
+      Agrif_Mygrid % rank = 1      
+C 
+C     Number of the root grid as a fixed grid   
+      Agrif_Mygrid % fixedrank = 0  
+C 
+C     Initialization of some fields of the root grid variables     
+      Call Agrif_Create_Var (Agrif_Mygrid)
+C      
+C     Initialization of the other fields of the root grid variables (number of 
+C     cells, positions, number and type of its dimensions, ...)  
+      Call Agrif_Set_numberofcells(Agrif_Mygrid)
+C      
+      Call Agrif_Instance (Agrif_Mygrid)        
+C
+      Call Agrif_Set_numberofcells(Agrif_Mygrid)          
+C             
+C     Allocation of the array containing the values of the grid variables
+      Call Agrif_Allocation (Agrif_Mygrid)
+C        
+      Call Agrif_initialisations(Agrif_Mygrid)    
+C      
+      nullify(Agrif_Mygrid % child_grids)
+C 
+C     Total number of fixed grids   
+      Agrif_nbfixedgrids = 0         
+C      
+      Call Agrif_Instance (Agrif_Mygrid)
+C        
+      End Subroutine Agrif_Init_Grids  
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Deallocation
+C     **************************************************************************
+C      
+      Subroutine Agrif_Deallocation
+C
+CCC   Description:
+CCC   Subroutine to initialize the root coarse grid pointed by Agrif_Mygrid. 
+CCC   It is called in the main program.
+C
+C     Declarations:
+C
+C
+      INTEGER :: nb
+C
+C             definition of the probdim and modtypes variables
+C
+      do nb = 1, Agrif_NbVariables
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array1) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array1)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array2) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array2)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array3) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array3)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array4) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array4)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array5) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array5)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array6) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array6)
+C
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray1) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray1)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray2) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray2)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray3) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray3)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray4) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray4)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray5) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray5)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray6) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray6)
+C
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray1) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray1)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray2) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray2)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray3) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray3)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray4) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray4)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray5) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray5)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray6) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray6)
+C
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % carray1) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % carray1)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % carray2) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % carray2)
+      enddo
+C
+      do nb = 1, Agrif_NbVariables
+        Deallocate(Agrif_Mygrid % tabvars(nb) % var)
+      enddo
+C
+      Deallocate(Agrif_Mygrid % tabvars)
+C
+      Deallocate(Agrif_Mygrid)
+C
+      End Subroutine  Agrif_Deallocation 
+C
+      End module Agrif_Util 
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modvariables.F
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modvariables.F	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modvariables.F	(revision 8201)
@@ -0,0 +1,152 @@
+      Module Agrif_Variables 
+      Use Agrif_CurgridFunctions
+      
+      Contains
+      Subroutine Agrif_Declare_Variable(posvar,firstpoint,
+     &    raf,lb,ub,varid,torestore)
+      character*(80) :: variablename
+      Type(Agrif_List_Variables), Pointer :: newvariable,newvariablep
+      INTEGER, DIMENSION(:) :: posvar
+      INTEGER, DIMENSION(:) :: lb,ub
+      INTEGER, DIMENSION(:) :: firstpoint
+      CHARACTER(*) ,DIMENSION(:) :: raf        
+      TYPE(Agrif_Pvariable), Pointer :: parent_var,root_var
+      INTEGER :: dimensio
+      INTEGER :: varid
+      LOGICAL, OPTIONAL :: torestore
+      LOGICAL :: restaure
+            
+!      if (agrif_root()) return
+
+      variablename = 'xxx'
+      
+      restaure = .FALSE.
+      if (agrif_mygrid%ngridstep /= 0) then
+        if (present(torestore)) restaure = torestore
+      endif
+      
+      dimensio = SIZE(posvar)
+C
+C    
+      Allocate(newvariable)
+      Allocate(newvariable%pvar)
+      Allocate(newvariable%pvar%var)
+      Allocate(newvariable%pvar%var%posvar(dimensio))
+      Allocate(newvariable%pvar%var%interptab(dimensio))
+      newvariable%pvar%var%variablename = variablename
+      newvariable%pvar%var%interptab = raf
+      newvariable%pvar%var%nbdim = dimensio
+      newvariable%pvar%var%posvar = posvar
+      newvariable%pvar%var%point(1:dimensio) = firstpoint
+      newvariable%pvar%var%restaure = restaure
+
+      newvariable%pvar%var%lb(1:dimensio) = lb(1:dimensio)
+      newvariable%pvar%var%ub(1:dimensio) = ub(1:dimensio)
+      
+      if (restaure) then
+      select case(dimensio)
+      case(1)
+                  Allocate( newvariable%pvar%var%Restore1D(  
+     &      lb(1):ub(1)))         
+            newvariable%pvar%var%Restore1D = 0      
+      case(2)
+                  Allocate( newvariable%pvar%var%Restore2D(  
+     &      lb(1):ub(1),lb(2):ub(2)))         
+            newvariable%pvar%var%Restore2D = 0
+      case(3)
+                  Allocate( newvariable%pvar%var%Restore3D(  
+     &      lb(1):ub(1),lb(2):ub(2),lb(3):ub(3)))         
+            newvariable%pvar%var%Restore3D = 0
+      case(4)
+                  Allocate( newvariable%pvar%var%Restore4D(  
+     &      lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4)))         
+            newvariable%pvar%var%Restore4D = 0
+      case(5)
+                  Allocate( newvariable%pvar%var%Restore5D(  
+     &      lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),
+     &      lb(5):ub(5)))         
+            newvariable%pvar%var%Restore5D = 0            
+      end select
+      endif
+      
+      newvariable % nextvariable => Agrif_Curgrid%variables
+      
+      Agrif_Curgrid%variables => newvariable
+      Agrif_Curgrid%Nbvariables = Agrif_Curgrid%Nbvariables + 1
+
+      varid = -Agrif_Curgrid%Nbvariables
+
+!       if (agrif_curgrid%parent%nbvariables < agrif_curgrid%nbvariables)
+!     &       then
+!      Allocate(newvariablep)
+!      Allocate(newvariablep%pvar)
+!      Allocate(newvariablep%pvar%var)      
+!      Allocate(newvariablep%pvar%var%posvar(dimensio))
+!      Allocate(newvariablep%pvar%var%interptab(dimensio))
+!      newvariablep%pvar%var%variablename = variablename
+!      newvariablep%pvar%var%interptab = raf
+!      newvariablep%pvar%var%nbdim = dimensio
+!      newvariablep%pvar%var%posvar = posvar
+!      newvariablep%pvar%var%point(1:dimensio) = firstpoint
+!      newvariablep%pvar%var%restaure = restaure      
+! 
+!      newvariablep%pvar%var%lb(1:dimensio) = lb(1:dimensio)
+!      newvariablep%pvar%var%ub(1:dimensio) = ub(1:dimensio)
+!           
+!      newvariablep % nextvariable => Agrif_Curgrid%parent%variables
+!      
+!      Agrif_Curgrid%parent%variables => newvariablep       
+!      
+!      Agrif_Curgrid%parent%Nbvariables = 
+!     &    Agrif_Curgrid%parent%Nbvariables + 1
+!      parent_var=>newvariablep%pvar
+!      else
+!      parent_var=>Agrif_Search_Variable
+!     &              (Agrif_Curgrid%parent,Agrif_Curgrid%nbvariables)
+!       endif
+       
+       if (.not.agrif_root()) then
+      parent_var=>Agrif_Search_Variable
+     &              (Agrif_Curgrid%parent,Agrif_Curgrid%nbvariables)       
+       
+       newvariable%pvar%parent_var=>parent_var
+       do i=1,dimensio
+         if (parent_var%var%interptab(i)=='N') then
+           parent_var%var%lb(i)=lb(i)
+           parent_var%var%ub(i)=ub(i)
+         endif
+       enddo
+       endif       
+      
+      root_var=>Agrif_Search_Variable
+     &              (Agrif_Mygrid,Agrif_Curgrid%nbvariables)
+     
+      newvariable%pvar%var%root_var=>root_var%var
+      
+           
+      End Subroutine Agrif_Declare_Variable
+
+      FUNCTION Agrif_Search_Variable(grid,varid)
+      integer :: varid
+      Type(Agrif_Pvariable), Pointer :: Agrif_Search_variable
+      Type(Agrif_grid), Pointer :: grid
+      
+      Type(Agrif_List_Variables), pointer :: parcours
+      Logical :: foundvariable
+      integer nb
+      integer :: varidinv
+      
+      foundvariable = .FALSE.
+      parcours => grid%variables
+      varidinv = 1 + grid%nbvariables - varid
+
+      do nb=1,varidinv-1
+         parcours => parcours%nextvariable    
+      End Do
+      
+      Agrif_Search_variable => parcours%pvar
+      
+      
+      End Function Agrif_Search_variable
+      
+      End Module Agrif_Variables      
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile.lex
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile.lex	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile.lex	(revision 8201)
@@ -0,0 +1,77 @@
+# 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_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile.lex.byacc
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile.lex.byacc	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile.lex.byacc	(revision 8201)
@@ -0,0 +1,76 @@
+# 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_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/LIB/convert.lex
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/LIB/convert.lex	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/LIB/convert.lex	(revision 8201)
@@ -0,0 +1,87 @@
+/******************************************************************************/
+/*                                                                            */
+/*     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_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/LIB/convert.y
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/LIB/convert.y	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/LIB/convert.y	(revision 8201)
@@ -0,0 +1,450 @@
+/******************************************************************************/
+/*                                                                            */
+/*     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_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.lex
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.lex	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.lex	(revision 8201)
@@ -0,0 +1,370 @@
+/******************************************************************************/
+/*                                                                            */
+/*     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_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.tab.c
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.tab.c	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.tab.c	(revision 8201)
@@ -0,0 +1,6863 @@
+/* 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_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.y
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.y	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.y	(revision 8201)
@@ -0,0 +1,2766 @@
+/******************************************************************************/
+/*                                                                            */
+/*     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_GO6M_dev/NEMOGCM/NEMO/OPA_SRC/C1D/dynnxt_c1d.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/OPA_SRC/C1D/dynnxt_c1d.F90	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/OPA_SRC/C1D/dynnxt_c1d.F90	(revision 8201)
@@ -0,0 +1,103 @@
+MODULE dynnxt_c1d
+   !!======================================================================
+   !!                       ***  MODULE  dynnxt_c1d  ***
+   !! Ocean dynamics: time stepping in 1D configuration
+   !!======================================================================
+   !! History :  2.0  !  2004-10  (C. Ethe)  Original code from dynnxt.F90
+   !!            3.0  !  2008-04  (G.madec)  Style only
+   !!----------------------------------------------------------------------
+#if defined key_c1d
+   !!----------------------------------------------------------------------
+   !!   'key_c1d'                                          1D Configuration
+   !!----------------------------------------------------------------------  
+   !!   dyn_nxt_c1d : update the horizontal velocity from the momentum trend
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! lateral boundary condition (or mpp link)
+   USE prtctl          ! Print control
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC dyn_nxt_c1d                ! routine called by step.F90
+   !!----------------------------------------------------------------------
+   !! NEMO/C1D 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dyn_nxt_c1d ( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_nxt_c1d  ***
+      !!                   
+      !! ** Purpose :   Compute the after horizontal velocity from the momentum trend.
+      !!
+      !! ** Method  :   Apply lateral boundary conditions on the trends (ua,va) 
+      !!      through calls to routine lbc_lnk.
+      !!      After velocity is compute using a leap-frog scheme environment:
+      !!         (ua,va) = (ub,vb) + 2 rdt (ua,va)
+      !!      Time filter applied on now horizontal velocity to avoid the
+      !!      divergence of two consecutive time-steps and swap of dynamics
+      !!      arrays to start the next time step:
+      !!         (ub,vb) = (un,vn) + atfp [ (ub,vb) + (ua,va) - 2 (un,vn) ]
+      !!         (un,vn) = (ua,va) 
+      !!
+      !! ** Action : - Update ub,vb arrays, the before horizontal velocity
+      !!             - Update un,vn arrays, the now horizontal velocity
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      !!
+      INTEGER  ::   jk           ! dummy loop indices
+      REAL(wp) ::   z2dt         ! temporary scalar
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_nxt_c1d : time stepping on 1D configuation'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+
+      z2dt = 2._wp * rdt                                                   ! Local constant initialization
+      IF( neuler == 0 .AND. kt == nit000 )  z2dt = rdt
+
+      CALL lbc_lnk( ua, 'U', -1. )   ;   CALL lbc_lnk( va, 'V', -1. )      ! Lateral boundary conditions
+
+      DO jk = 1, jpkm1                                                     ! Next Velocity
+         ua(:,:,jk) = ( ub(:,:,jk) + z2dt * ua(:,:,jk) ) * umask(:,:,jk)
+         va(:,:,jk) = ( vb(:,:,jk) + z2dt * va(:,:,jk) ) * vmask(:,:,jk)
+      END DO 
+ 
+      DO jk = 1, jpkm1                                                     ! Time filter and swap of dynamics arrays
+         IF( neuler == 0 .AND. kt == nit000 ) THEN                               ! Euler (forward) time stepping
+             ub(:,:,jk) = un(:,:,jk)
+             vb(:,:,jk) = vn(:,:,jk)
+             un(:,:,jk) = ua(:,:,jk)
+             vn(:,:,jk) = va(:,:,jk)
+         ELSE                                                                    ! Leap-frog time stepping
+             ub(:,:,jk) = atfp * ( ub(:,:,jk) + ua(:,:,jk) ) + atfp1 * un(:,:,jk)
+             vb(:,:,jk) = atfp * ( vb(:,:,jk) + va(:,:,jk) ) + atfp1 * vn(:,:,jk)
+             un(:,:,jk) = ua(:,:,jk)
+             vn(:,:,jk) = va(:,:,jk)
+         ENDIF
+      END DO
+
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=un, clinfo1=' nxt_c1d  - Un: ', mask1=umask,   &
+         &                       tab3d_2=vn, clinfo2=' Vn: '           , mask2=vmask )
+      !
+   END SUBROUTINE dyn_nxt_c1d
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default key                                     NO 1D Config
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE dyn_nxt_c1d ( kt )
+      WRITE(*,*) 'dyn_nxt_c1d: You should not have seen this print! error?', kt
+   END SUBROUTINE dyn_nxt_c1d
+#endif
+
+   !!======================================================================
+END MODULE dynnxt_c1d
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/OPA_SRC/TRD/trdtrc.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/OPA_SRC/TRD/trdtrc.F90	(revision 8200)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/OPA_SRC/TRD/trdtrc.F90	(revision 8201)
@@ -1,2 +1,3 @@
+#if ! defined key_top
 MODULE trdtrc
    !!======================================================================
@@ -22,2 +23,3 @@
    !!======================================================================
 END MODULE trdtrc
+#endif
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 8200)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 8201)
@@ -75,4 +75,5 @@
 #if defined key_top
    USE trcini          ! passive tracer initialisation
+   USE trc, ONLY: numstr  ! tracer stats unit number
 #endif
    USE lib_mpp         ! distributed memory computing
@@ -627,4 +628,5 @@
       IF( numdct_heat     /= -1 )   CLOSE( numdct_heat     )   ! heat transports
       IF( numdct_salt     /= -1 )   CLOSE( numdct_salt     )   ! salt transports
+      IF( numstr          /= -1 )   CLOSE( numstr          )   ! tracer statistics 
 
       !
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/AGE/par_age.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/AGE/par_age.F90	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/AGE/par_age.F90	(revision 8201)
@@ -0,0 +1,83 @@
+MODULE par_age
+   !!======================================================================
+   !!                        ***  par_age  ***
+   !! TOP :   set the AGE parameters
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   USE par_pisces , ONLY : jp_pisces       !: number of tracers in PISCES
+   USE par_pisces , ONLY : jp_pisces_2d    !: number of 2D diag in PISCES
+   USE par_pisces , ONLY : jp_pisces_3d    !: number of 3D diag in PISCES
+   USE par_pisces , ONLY : jp_pisces_trd   !: number of biological diag in PISCES
+
+   USE par_medusa , ONLY : jp_medusa       !: number of tracers in MEDUSA
+   USE par_medusa , ONLY : jp_medusa_2d    !: number of 2D diag in MEDUSA
+   USE par_medusa , ONLY : jp_medusa_3d    !: number of 3D diag in MEDUSA
+   USE par_medusa , ONLY : jp_medusa_trd   !: number of biological diag in MEDUSA
+
+   USE par_idtra  , ONLY : jp_idtra        !: number of tracers in MEDUSA
+   USE par_idtra  , ONLY : jp_idtra_2d     !: number of tracers in MEDUSA
+   USE par_idtra  , ONLY : jp_idtra_3d     !: number of tracers in MEDUSA
+   USE par_idtra  , ONLY : jp_idtra_trd    !: number of tracers in MEDUSA
+
+   USE par_cfc    , ONLY : jp_cfc          !: number of tracers in CFC
+   USE par_cfc    , ONLY : jp_cfc_2d       !: number of tracers in CFC
+   USE par_cfc    , ONLY : jp_cfc_3d       !: number of tracers in CFC
+   USE par_cfc    , ONLY : jp_cfc_trd      !: number of tracers in CFC
+
+   USE par_c14b   , ONLY : jp_c14b         !: number of tracers in C14
+   USE par_c14b   , ONLY : jp_c14b_2d      !: number of tracers in C14
+   USE par_c14b   , ONLY : jp_c14b_3d      !: number of tracers in C14
+   USE par_c14b   , ONLY : jp_c14b_trd     !: number of tracers in C14
+
+   IMPLICIT NONE
+
+   INTEGER, PARAMETER ::   jp_lm      =  jp_pisces     + jp_medusa     +            &
+                      jp_idtra      + jp_cfc     + jp_c14b     !:  cum. number of pass. tracers
+   INTEGER, PARAMETER ::   jp_lm_2d   =  jp_pisces_2d  + jp_medusa_2d  +            &
+                      jp_idtra_2d   + jp_cfc_2d  + jp_c14b_2d  !:
+   INTEGER, PARAMETER ::   jp_lm_3d   =  jp_pisces_3d  + jp_medusa_3d  +            &
+                      jp_idtra_3d   + jp_cfc_3d  + jp_c14b_3d  !:
+   INTEGER, PARAMETER ::   jp_lm_trd  =  jp_pisces_trd + jp_medusa_trd +            &
+                      jp_idtra_trd  + jp_cfc_trd + jp_c14b_trd !:
+
+#if defined key_age
+   !!---------------------------------------------------------------------
+   !!   'key_age'                     user defined tracers (AGE)
+   !!---------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_age     = .TRUE.   !: PTS flag 
+   INTEGER, PUBLIC, PARAMETER ::   jp_age     =  1       !: number of PTS tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_age_2d  =  0       !: additional 2d output arrays ('key_trc_diaadd')
+   INTEGER, PUBLIC, PARAMETER ::   jp_age_3d  =  0       !: additional 3d output arrays ('key_trc_diaadd')
+   INTEGER, PUBLIC, PARAMETER ::   jp_age_trd =  0       !: number of sms trends for AGE
+
+   ! assign an index in trc arrays for each PTS prognostic variables
+   INTEGER, PUBLIC, PARAMETER ::   jpage1 = jp_lm + 1     !: 1st AGE tracer
+
+#else
+   !!---------------------------------------------------------------------
+   !!   Default                           No user defined tracers (AGE)
+   !!---------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_age     = .FALSE.  !: AGE flag 
+   INTEGER, PUBLIC, PARAMETER ::   jp_age     =  0       !: No AGE tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_age_2d  =  0       !: No AGE additional 2d output arrays 
+   INTEGER, PUBLIC, PARAMETER ::   jp_age_3d  =  0       !: No AGE additional 3d output arrays 
+   INTEGER, PUBLIC, PARAMETER ::   jp_age_trd =  0       !: number of sms trends for AGE
+#endif
+
+   ! Starting/ending PISCES do-loop indices (N.B. no PISCES : jpl_pcs < jpf_pcs the do-loop are never done)
+   INTEGER, PUBLIC, PARAMETER ::   jp_age0     = jp_lm     + 1              !: First index of AGE passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_age1     = jp_lm     + jp_age      !: Last  index of AGE passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_age0_2d  = jp_lm_2d  + 1              !: First index of AGE passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_age1_2d  = jp_lm_2d  + jp_age_2d   !: Last  index of AGE passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_age0_3d  = jp_lm_3d  + 1              !: First index of AGE passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_age1_3d  = jp_lm_3d  + jp_age_3d   !: Last  index of AGE passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_age0_trd = jp_lm_trd + 1              !: First index of AGE passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_age1_trd = jp_lm_trd + jp_age_trd  !: Last  index of AGE passive tracers
+
+   !!======================================================================
+END MODULE par_age
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/AGE/trcini_age.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/AGE/trcini_age.F90	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/AGE/trcini_age.F90	(revision 8201)
@@ -0,0 +1,71 @@
+MODULE trcini_age
+   !!======================================================================
+   !!                         ***  MODULE trcini_age  ***
+   !! TOP :   initialisation of the AGE tracer
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (G. Nurser, G. Madec, C. Ethe ) Original code
+   !!----------------------------------------------------------------------
+#if defined key_age
+   !!----------------------------------------------------------------------
+   !!   'key_age'                                               AGE tracer
+   !!----------------------------------------------------------------------
+   !! trc_ini_age   : MY_TRC model initialisation
+   !!----------------------------------------------------------------------
+   USE oce_trc
+   USE trc
+   USE trcsms_age
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_ini_age   ! called by trcini.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_ini_age
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_ini_age  ***  
+      !!
+      !! ** Purpose :   initialization for AGE model
+      !!
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_ini_age: passive tracer age'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+
+      rryear  = 1._wp / ( nyear_len(1) * rday )    ! recip number of seconds in one year
+
+      !! BUG in s-coordinate this does not work!
+      nlb_age = MINLOC( gdepw_1d, mask = gdepw_1d > rn_age_depth, dim = 1 ) ! shallowest W level Below age_depth
+                                                                            !  = shallowest T level wholly below age_depth
+
+      nl_age  = nlb_age - 1                                                 ! deepest    W level Above age_depth
+                                                                            !  = T level surrounding age_depth
+
+      nla_age = nl_age - 1                                                   ! deepest    T level wholly above age_depth
+
+      frac_kill_age = ( rn_age_depth - gdepw_1d(nl_age) ) / e3t_1d(nl_age)      ! fraction of level nl_age above age_depth
+      frac_add_age  = 1._wp -  frac_kill_age                                    ! fraction of level nl_age below age_depth
+
+      
+      IF( .NOT. ln_rsttr ) trn(:,:,:,jp_age0:jp_age1) = 0.
+      !
+   END SUBROUTINE trc_ini_age
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                                        No AGE model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_ini_age             ! Empty routine
+   END SUBROUTINE trc_ini_age
+#endif
+
+   !!======================================================================
+END MODULE trcini_age
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/AGE/trcnam_age.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/AGE/trcnam_age.F90	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/AGE/trcnam_age.F90	(revision 8201)
@@ -0,0 +1,82 @@
+MODULE trcnam_age
+   !!======================================================================
+   !!                         ***  MODULE trcnam_age  ***
+   !! TOP :   initialisation of some run parameters for Age tracer
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) 
+   !!----------------------------------------------------------------------
+#if defined key_age
+   !!----------------------------------------------------------------------
+   !!   'key_age'                                               AGE tracers
+   !!----------------------------------------------------------------------
+   !! trc_nam_age      : AGE  tracer initialisation
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! Ocean variables
+   USE trcsms_age      ! AGE specific variable
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_nam_age   ! called by trcnam.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_nam_age
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_nam_age  ***
+      !!                 
+      !! ** Purpose :   Definition some run parameter for AGE model
+      !!
+      !! ** input   :   Namelist namage
+      !!----------------------------------------------------------------------
+      INTEGER ::  numnatg_ref = -1   ! Logical unit for reference AGE namelist
+      INTEGER ::  numnatg_cfg = -1   ! Logical unit for configuration AGE namelist
+      INTEGER ::  numong      = -1   ! Logical unit for output namelist
+      INTEGER :: ios                 ! Local integer output status for namelist read
+      INTEGER :: jl, jn
+      !!
+      NAMELIST/namage/ rn_age_depth, rn_age_kill_rate 
+      !!----------------------------------------------------------------------
+      !                             ! Open namelist files
+      CALL ctl_opn( numnatg_ref, 'namelist_age_ref'   ,     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+      CALL ctl_opn( numnatg_cfg, 'namelist_age_cfg'   ,     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+      IF(lwm) CALL ctl_opn( numong, 'output.namelist.age', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+
+      REWIND( numnatg_ref )              ! Namelist namagedate in reference namelist : AGE parameters
+      READ  ( numnatg_ref, namage, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namage in reference namelist', lwp )
+
+      REWIND( numnatg_cfg )              ! Namelist namagedate in configuration namelist : AGE parameters
+      READ  ( numnatg_cfg, namage, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namage in configuration namelist', lwp )
+      IF(lwm) WRITE ( numong, namage )
+
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) ' trc_nam_age: Read namage, namelist for Age passive tracer'
+         WRITE(numout,*) ' ~~~~~~~'
+         WRITE(numout,*) '  depth over which age tracer reset to zero                              rn_age_depth      = ', rn_age_depth 
+         WRITE(numout,*) '  recip of relax. timescale (s) for age tracer shallower than age_depth  rn_age_kill_rate  = ', rn_age_kill_rate 
+      ENDIF
+
+      IF(lwm) CALL FLUSH ( numong )     ! flush output namelist
+
+   END SUBROUTINE trc_nam_age
+   
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                                No AGE
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_nam_age                      ! Empty routine
+   END  SUBROUTINE  trc_nam_age
+#endif  
+
+   !!======================================================================
+END MODULE trcnam_age
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/AGE/trcsms_age.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/AGE/trcsms_age.F90	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/AGE/trcsms_age.F90	(revision 8201)
@@ -0,0 +1,100 @@
+MODULE trcsms_age
+   !!======================================================================
+   !!                         ***  MODULE trcsms_age  ***
+   !! TOP :   Main module of the AGE tracers
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code
+   !!----------------------------------------------------------------------
+#if defined key_age
+   !!----------------------------------------------------------------------
+   !!   'key_age'                                               AGE tracer
+   !!----------------------------------------------------------------------
+   !! trc_sms_age       : AGE model main routine
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! Ocean variables
+   USE trc             ! TOP variables
+   USE trd_oce
+   USE trdtrc
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_sms_age       ! called by trcsms.F90 module
+
+   INTEGER , PUBLIC :: nl_age             ! T level surrounding age_depth
+   INTEGER , PUBLIC :: nla_age            ! T level wholly above age_depth
+   INTEGER , PUBLIC :: nlb_age            ! T level wholly below age_depth
+
+   REAL(wp), PUBLIC :: rn_age_depth       ! = 10       depth over which age tracer reset to zero
+   REAL(wp), PUBLIC :: rn_age_kill_rate   ! = -1./7200  recip of relaxation timescale (s) for  age tracer shallower than age_depth
+   
+   REAL(wp), PUBLIC :: rryear          !: recip number of seconds in one year
+   REAL(wp), PUBLIC :: frac_kill_age   !: fraction of level nl_age above age_depth where it is relaxed towards zero
+   REAL(wp), PUBLIC :: frac_add_age    !: fraction of level nl_age below age_depth where it is incremented
+
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_sms_age( kt )
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_sms_age  ***
+      !!
+      !! ** Purpose :   main routine of AGE model
+      !!
+      !! ** Method  : -
+      !!----------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER ::   jn, jk   ! dummy loop index
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrage
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_sms_age')
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_sms_age:  AGE model'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+
+      IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrage )
+
+      DO jk = 1, nla_age
+         tra(:,:,jk,jpage1) = rn_age_kill_rate * trb(:,:,jk,jpage1)
+      ENDDO
+      !
+      tra(:,:,nl_age,jpage1) = frac_kill_age * rn_age_kill_rate * trb(:,:,nl_age,jpage1)  &
+          &                  + frac_add_age  * rryear * tmask(:,:,nl_age)
+      !
+      DO jk = nlb_age, jpk
+         tra(:,:,jk,jpage1) = tmask(:,:,jk) * rryear
+      ENDDO
+      !
+      IF( l_trdtrc ) THEN      ! Save the trends in the mixed layer
+          DO jn = jp_age0, jp_age1
+            ztrage(:,:,:) = tra(:,:,:,jn)
+            CALL trd_trc( ztrage, jn, jptra_sms, kt )   ! save trends
+          END DO
+          CALL wrk_dealloc( jpi, jpj, jpk, ztrage )
+      END IF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_age')
+      !
+   END SUBROUTINE trc_sms_age
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                                        No AGE model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_sms_age( kt )             ! Empty routine
+      INTEGER, INTENT( in ) ::   kt
+      WRITE(*,*) 'trc_sms_age: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_sms_age
+#endif
+
+   !!======================================================================
+END MODULE trcsms_age
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/AGE/trcwri_age.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/AGE/trcwri_age.F90	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/AGE/trcwri_age.F90	(revision 8201)
@@ -0,0 +1,62 @@
+MODULE trcwri_age
+   !!======================================================================
+   !!                       *** MODULE trcwri ***
+   !!    age :   Output of age tracers
+   !!======================================================================
+   !! History :   1.0  !  2009-05 (C. Ethe)  Original code
+   !!----------------------------------------------------------------------
+#if defined key_top && defined key_age && defined key_iomput
+   !!----------------------------------------------------------------------
+   !!   'key_age'                                           age model
+   !!----------------------------------------------------------------------
+   !! trc_wri_age   :  outputs of concentration fields
+   !!----------------------------------------------------------------------
+   USE par_age     
+   USE trc         
+   USE iom
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC trc_wri_age 
+
+#  include "top_substitute.h90"
+CONTAINS
+
+   SUBROUTINE trc_wri_age
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_wri_trc  ***
+      !!
+      !! ** Purpose :   output passive tracers fields 
+      !!---------------------------------------------------------------------
+      CHARACTER (len=20)   :: cltra
+      INTEGER              :: jn
+      !!---------------------------------------------------------------------
+
+ 
+      ! write the tracer concentrations in the file
+      ! ---------------------------------------
+      DO jn = jp_age0, jp_age1
+         cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer
+         CALL iom_put( TRIM(cltra), trn(:,:,:,jn) )
+      END DO
+      !
+      !
+   END SUBROUTINE trc_wri_age
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+   PUBLIC trc_wri_age
+CONTAINS
+   SUBROUTINE trc_wri_age                     ! Empty routine  
+   END SUBROUTINE trc_wri_age
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE trcwri_age
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/C14b/par_c14b.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/C14b/par_c14b.F90	(revision 8200)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/C14b/par_c14b.F90	(revision 8201)
@@ -11,4 +11,14 @@
    USE par_pisces , ONLY : jp_pisces_trd   !: number of biological diag in PISCES
 
+   USE par_medusa , ONLY : jp_medusa       !: number of tracers in MEDUSA
+   USE par_medusa , ONLY : jp_medusa_2d    !: number of 2D diag in MEDUSA
+   USE par_medusa , ONLY : jp_medusa_3d    !: number of 3D diag in MEDUSA
+   USE par_medusa , ONLY : jp_medusa_trd   !: number of biological diag in MEDUSA
+
+   USE par_idtra  , ONLY : jp_idtra        !: number of tracers in MEDUSA
+   USE par_idtra  , ONLY : jp_idtra_2d     !: number of tracers in MEDUSA
+   USE par_idtra  , ONLY : jp_idtra_3d     !: number of tracers in MEDUSA
+   USE par_idtra  , ONLY : jp_idtra_trd    !: number of tracers in MEDUSA
+
    USE par_cfc    , ONLY : jp_cfc          !: number of tracers in CFC
    USE par_cfc    , ONLY : jp_cfc_2d       !: number of 2D diag in CFC
@@ -19,8 +29,12 @@
    IMPLICIT NONE
 
-   INTEGER, PARAMETER ::   jp_lb      =  jp_pisces     + jp_cfc     !: cum. number of pass. tracers
-   INTEGER, PARAMETER ::   jp_lb_2d   =  jp_pisces_2d  + jp_cfc_2d  !:
-   INTEGER, PARAMETER ::   jp_lb_3d   =  jp_pisces_3d  + jp_cfc_3d  !:
-   INTEGER, PARAMETER ::   jp_lb_trd  =  jp_pisces_trd + jp_cfc_trd !:
+   INTEGER, PARAMETER ::   jp_lb      =  jp_pisces     + jp_medusa     +   &
+                      jp_idtra      + jp_cfc                               !: cum. number of pass. tracers
+   INTEGER, PARAMETER ::   jp_lb_2d   =  jp_pisces_2d  + jp_medusa_2d  +   &
+                      jp_idtra_2d   + jp_cfc_2d  !:
+   INTEGER, PARAMETER ::   jp_lb_3d   =  jp_pisces_3d  + jp_medusa_3d  +   &
+                      jp_idtra_3d   + jp_cfc_3d  !:
+   INTEGER, PARAMETER ::   jp_lb_trd  =  jp_pisces_trd + jp_medusa_trd +   &
+                      jp_idtra_trd  + jp_cfc_trd !:
    
 #if defined key_c14b
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/CFC/par_cfc.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/CFC/par_cfc.F90	(revision 8200)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/CFC/par_cfc.F90	(revision 8201)
@@ -5,4 +5,5 @@
    !!======================================================================
    !! History :   2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture
+   !!                  !  2017-04  (A. Yool)  add SF6
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -15,10 +16,24 @@
    USE par_pisces , ONLY : jp_pisces_trd   !: number of biological diag in PISCES
 
+   USE par_medusa , ONLY : jp_medusa       !: number of tracers in MEDUSA
+   USE par_medusa , ONLY : jp_medusa_2d    !: number of 2D diag in MEDUSA
+   USE par_medusa , ONLY : jp_medusa_3d    !: number of 3D diag in MEDUSA
+   USE par_medusa , ONLY : jp_medusa_trd   !: number of biological diag in MEDUSA
+
+   USE par_idtra  , ONLY : jp_idtra        !: number of tracers in ideal tracer
+   USE par_idtra  , ONLY : jp_idtra_2d     !: number of tracers in ideal tracer
+   USE par_idtra  , ONLY : jp_idtra_3d     !: number of tracers in ideal tracer
+   USE par_idtra  , ONLY : jp_idtra_trd    !: number of tracers in ideal tracer
+
    IMPLICIT NONE
 
-   INTEGER, PARAMETER ::   jp_lc      =  jp_pisces     !: cumulative number of passive tracers
-   INTEGER, PARAMETER ::   jp_lc_2d   =  jp_pisces_2d  !:
-   INTEGER, PARAMETER ::   jp_lc_3d   =  jp_pisces_3d  !:
-   INTEGER, PARAMETER ::   jp_lc_trd  =  jp_pisces_trd !:
+   INTEGER, PARAMETER ::   jp_lc      =  jp_pisces     + jp_medusa     + &
+                      jp_idtra     !: cumulative number of passive tracers
+   INTEGER, PARAMETER ::   jp_lc_2d   =  jp_pisces_2d  + jp_medusa_2d  + &
+                      jp_idtra_2d !:
+   INTEGER, PARAMETER ::   jp_lc_3d   =  jp_pisces_3d  + jp_medusa_3d  + &
+                      jp_idtra_3d !:
+   INTEGER, PARAMETER ::   jp_lc_trd  =  jp_pisces_trd + jp_medusa_trd + &
+                      jp_idtra_trd !:
    
 #if defined key_cfc
@@ -27,6 +42,6 @@
    !!---------------------------------------------------------------------
    LOGICAL, PUBLIC, PARAMETER ::   lk_cfc     = .TRUE.      !: CFC flag 
-   INTEGER, PUBLIC, PARAMETER ::   jp_cfc     =  1          !: number of passive tracers
-   INTEGER, PUBLIC, PARAMETER ::   jp_cfc_2d  =  2          !: additional 2d output arrays ('key_trc_diaadd')
+   INTEGER, PUBLIC, PARAMETER ::   jp_cfc     =  3          !: number of passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_cfc_2d  =  6          !: additional 2d output arrays ('key_trc_diaadd')
    INTEGER, PUBLIC, PARAMETER ::   jp_cfc_3d  =  0          !: additional 3d output arrays ('key_trc_diaadd')
    INTEGER, PUBLIC, PARAMETER ::   jp_cfc_trd =  0          !: number of sms trends for CFC
@@ -34,5 +49,6 @@
    ! assign an index in trc arrays for each CFC prognostic variables
    INTEGER, PUBLIC, PARAMETER ::   jpc11       = jp_lc + 1   !: CFC-11 
-   INTEGER, PUBLIC, PARAMETER ::   jpc12       = jp_lc + 2   !: CFC-12   
+   INTEGER, PUBLIC, PARAMETER ::   jpc12       = jp_lc + 2   !: CFC-12 (priority tracer for CMIP6)
+   INTEGER, PUBLIC, PARAMETER ::   jpsf6       = jp_lc + 3   !: SF6
 #else
    !!---------------------------------------------------------------------
@@ -47,12 +63,12 @@
 
    ! Starting/ending CFC do-loop indices (N.B. no CFC : jp_cfc0 > jp_cfc1 the do-loop are never done)
-   INTEGER, PUBLIC, PARAMETER ::   jp_cfc0     = jp_lc + 1       !: First index of CFC tracers
-   INTEGER, PUBLIC, PARAMETER ::   jp_cfc1     = jp_lc + jp_cfc  !: Last  index of CFC tracers
-   INTEGER, PUBLIC, PARAMETER ::   jp_cfc0_2d  = jp_lc_2d  + 1       !: First index of CFC tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_cfc0     = jp_lc + 1              !: First index of CFC tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_cfc1     = jp_lc + jp_cfc         !: Last  index of CFC tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_cfc0_2d  = jp_lc_2d  + 1          !: First index of CFC tracers
    INTEGER, PUBLIC, PARAMETER ::   jp_cfc1_2d  = jp_lc_2d  + jp_cfc_2d  !: Last  index of CFC tracers
-   INTEGER, PUBLIC, PARAMETER ::   jp_cfc0_3d  = jp_lc_3d  + 1       !: First index of CFC tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_cfc0_3d  = jp_lc_3d  + 1          !: First index of CFC tracers
    INTEGER, PUBLIC, PARAMETER ::   jp_cfc1_3d  = jp_lc_3d  + jp_cfc_3d  !: Last  index of CFC tracers
-   INTEGER, PUBLIC, PARAMETER ::   jp_cfc0_trd = jp_lc_trd + 1       !: First index of CFC tracers
-   INTEGER, PUBLIC, PARAMETER ::   jp_cfc1_trd = jp_lc_trd + jp_cfc_trd  !: Last  index of CFC tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_cfc0_trd = jp_lc_trd + 1          !: First index of CFC tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_cfc1_trd = jp_lc_trd + jp_cfc_trd !: Last  index of CFC tracers
 
    !!======================================================================
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/CFC/trcini_cfc.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/CFC/trcini_cfc.F90	(revision 8200)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/CFC/trcini_cfc.F90	(revision 8201)
@@ -5,4 +5,5 @@
    !!======================================================================
    !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) 
+   !!                  !  2017-04  (A. Yool)  Add SF6
    !!----------------------------------------------------------------------
 #if defined key_cfc
@@ -22,5 +23,5 @@
    PUBLIC   trc_ini_cfc   ! called by trcini.F90 module
 
-   CHARACTER (len=34) ::   clname = 'cfc1112.atm'   ! ???
+   CHARACTER (len=34) ::   clname = 'cfc1112sf6.atm'   ! ???
 
    INTEGER  ::   inum                   ! unit number
@@ -44,5 +45,5 @@
       !!----------------------------------------------------------------------
       INTEGER  ::  ji, jj, jn, jl, jm, js, io, ierr
-      INTEGER  ::  iskip = 6   ! number of 1st descriptor lines
+      INTEGER  ::  iskip = 7   ! number of 1st descriptor lines
       REAL(wp) ::  zyy, zyd
       !!----------------------------------------------------------------------
@@ -53,5 +54,5 @@
 
 
-      IF(lwp) WRITE(numout,*) 'read of formatted file cfc1112atm'
+      IF(lwp) WRITE(numout,*) 'read of formatted file cfc1112sf6.atm'
       
       CALL ctl_opn( inum, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
@@ -69,5 +70,5 @@
       !                                ! Allocate CFC arrays
 
-      ALLOCATE( p_cfc(jpyear,jphem,2), STAT=ierr )
+      ALLOCATE( p_cfc(jpyear,jphem,3), STAT=ierr )
       IF( ierr > 0 ) THEN
          CALL ctl_stop( 'trc_ini_cfc: unable to allocate p_cfc array' )   ;   RETURN
@@ -90,8 +91,5 @@
          ENDIF
          qint_cfc(:,:,:) = 0._wp
-         DO jl = 1, jp_cfc
-            jn = jp_cfc0 + jl - 1
-            trn(:,:,:,jn) = 0._wp
-         END DO
+         trn(:,:,:,jp_cfc0:jp_cfc1) = 0._wp
       ENDIF
 
@@ -105,26 +103,30 @@
       jn = 31
       DO 
-        READ(inum,*, IOSTAT=io) zyy, p_cfc(jn,1,1), p_cfc(jn,1,2), p_cfc(jn,2,1), p_cfc(jn,2,2)
+        READ(inum,*, IOSTAT=io) zyy, p_cfc(jn,1,1), p_cfc(jn,1,2), &
+             & p_cfc(jn,1,3), p_cfc(jn,2,1),  &
+             & p_cfc(jn,2,2), p_cfc(jn,2,3)
         IF( io < 0 ) exit
         jn = jn + 1
       END DO
 
-      p_cfc(32,1:2,1) = 5.e-4      ! modify the values of the first years
-      p_cfc(33,1:2,1) = 8.e-4
-      p_cfc(34,1:2,1) = 1.e-6
-      p_cfc(35,1:2,1) = 2.e-3
-      p_cfc(36,1:2,1) = 4.e-3
-      p_cfc(37,1:2,1) = 6.e-3
-      p_cfc(38,1:2,1) = 8.e-3
-      p_cfc(39,1:2,1) = 1.e-2
+      ! AXY (25/04/17): do not adjust
+      ! p_cfc(32,1:2,1) = 5.e-4      ! modify the values of the first years
+      ! p_cfc(33,1:2,1) = 8.e-4
+      ! p_cfc(34,1:2,1) = 1.e-6
+      ! p_cfc(35,1:2,1) = 2.e-3
+      ! p_cfc(36,1:2,1) = 4.e-3
+      ! p_cfc(37,1:2,1) = 6.e-3
+      ! p_cfc(38,1:2,1) = 8.e-3
+      ! p_cfc(39,1:2,1) = 1.e-2
       
       IF(lwp) THEN        ! Control print
          WRITE(numout,*)
-         WRITE(numout,*) ' Year   p11HN    p11HS    p12HN    p12HS '
+         WRITE(numout,*) ' Year   p11HN    p11HS    p12HN    p12HS    pSF6N    pSF6S '
          DO jn = 30, jpyear
-            WRITE(numout, '( 1I4, 4F9.2)') jn, p_cfc(jn,1,1), p_cfc(jn,2,1), p_cfc(jn,1,2), p_cfc(jn,2,2)
+            WRITE(numout, '( 1I4, 6F9.2)') jn, p_cfc(jn,1,1), p_cfc(jn,2,1), &
+                 & p_cfc(jn,1,2), p_cfc(jn,2,2), &
+                 & p_cfc(jn,1,3), p_cfc(jn,2,3)
          END DO
       ENDIF
-
 
       ! Interpolation factor of atmospheric partial pressure
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/CFC/trcnam_cfc.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/CFC/trcnam_cfc.F90	(revision 8200)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/CFC/trcnam_cfc.F90	(revision 8201)
@@ -49,5 +49,5 @@
       TYPE(DIAG), DIMENSION(jp_cfc_2d) :: cfcdia2d
       !!
-      NAMELIST/namcfcdate/ ndate_beg, nyear_res
+      NAMELIST/namcfcdate/ ndate_beg, nyear_res, simu_type 
       NAMELIST/namcfcdia/  cfcdia2d     ! additional diagnostics
       !!----------------------------------------------------------------------
@@ -72,4 +72,9 @@
          WRITE(numout,*) '    initial calendar date (aammjj) for CFC  ndate_beg = ', ndate_beg
          WRITE(numout,*) '    restoring time constant (year)          nyear_res = ', nyear_res
+         IF (simu_type==1) THEN
+            WRITE(numout,*) ' CFC running on SPIN-UP mode             simu_type = ', simu_type
+         ELSEIF (simu_type==2) THEN
+            WRITE(numout,*) ' CFC running on HINDCAST/PROJECTION mode simu_type = ', simu_type
+         ENDIF
       ENDIF
       nyear_beg = ndate_beg / 10000
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90	(revision 8200)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90	(revision 8201)
@@ -7,4 +7,6 @@
    !!  NEMO      1.0  !  2004-03  (C. Ethe) free form + modularity
    !!            2.0  !  2007-12  (C. Ethe, G. Madec)  reorganisation
+   !!                 !  2016-06  (J. Palmieri)  update for UKESM1
+   !!                 !  2017-04  (A. Yool)  update to add SF6, fix coefficients
    !!----------------------------------------------------------------------
 #if defined key_cfc
@@ -15,4 +17,5 @@
    !!   cfc_init     :  sets constants for CFC surface forcing computation
    !!----------------------------------------------------------------------
+   USE dom_oce       ! ocean space and time domain
    USE oce_trc       ! Ocean variables
    USE par_trc       ! TOP parameters
@@ -31,4 +34,6 @@
    INTEGER , PUBLIC            ::   jpyear         ! Number of years read in CFC1112 file
    INTEGER , PUBLIC            ::   ndate_beg      ! initial calendar date (aammjj) for CFC
+   INTEGER , PUBLIC            ::   simu_type      ! Kind of simulation: 1- Spin-up 
+                                                   !                     2- Hindcast/projection
    INTEGER , PUBLIC            ::   nyear_res      ! restoring time constant (year)
    INTEGER , PUBLIC            ::   nyear_beg      ! initial year (aa) 
@@ -40,7 +45,7 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   patm     ! atmospheric function
 
-   REAL(wp), DIMENSION(4,2) ::   soa   ! coefficient for solubility of CFC [mol/l/atm]
-   REAL(wp), DIMENSION(3,2) ::   sob   !    "               "
-   REAL(wp), DIMENSION(4,2) ::   sca   ! coefficients for schmidt number in degre Celcius
+   REAL(wp), DIMENSION(4,3) ::   soa   ! coefficient for solubility of CFC [mol/l/atm]
+   REAL(wp), DIMENSION(3,3) ::   sob   !    "               "
+   REAL(wp), DIMENSION(5,3) ::   sca   ! coefficients for schmidt number in degre Celcius
       
    !                          ! coefficients for conversion
@@ -79,8 +84,8 @@
       !
       INTEGER  ::   ji, jj, jn, jl, jm, js
-      INTEGER  ::   iyear_beg, iyear_end
+      INTEGER  ::   iyear_beg, iyear_end, iyear_tmp
       INTEGER  ::   im1, im2, ierr
       REAL(wp) ::   ztap, zdtap        
-      REAL(wp) ::   zt1, zt2, zt3, zv2
+      REAL(wp) ::   zt1, zt2, zt3, zt4, zv2
       REAL(wp) ::   zsol      ! solubility
       REAL(wp) ::   zsch      ! schmidt number 
@@ -103,5 +108,38 @@
       ! Temporal interpolation
       ! ----------------------
-      iyear_beg = nyear - 1900
+      !! JPALM -- 15-06-2016 -- define 2 kinds of CFC run:
+      !!                     1- the SPIN-UP and 2- Hindcast/Projections
+      !!                     -- main difference is the way to define the year of
+      !!                     simulation, that determine the atm pCFC.
+      !!                     1-- Spin-up: our atm forcing is of 30y we cycle on.
+      !!                     So we do 90y CFC cycles to be in good
+      !!                     correspondence with the atmosphere
+      !!                     2-- Hindcast/proj, instead of nyear-1900 we keep
+      !!                     the 2 last digit, and enable 3 cycle from 1800 to 2100.  
+      !!----------------------------------------------------------------------
+      IF (simu_type==1) THEN
+         !! 1 -- SPIN-UP
+         iyear_tmp = nyear - nyear_res  !! JPALM -- in our spin-up, nyear_res is 1000
+         iyear_beg = MOD( iyear_tmp , 90 )
+         !! JPALM -- the pCFC file only got 78 years.
+         !!       So if iyear_beg > 78 then we set pCFC to 0
+         !!             iyear_beg = 0 as well -- must try to avoid obvious problems
+         !!             as Pcfc is set to 0.00 up to year 32, let set iyear_beg to year 10
+         !!          else, must add 30 to iyear_beg to match with P_cfc indices
+         !!---------------------------------------
+         IF ((iyear_beg > 77) .OR. (iyear_beg==0)) THEN
+            iyear_beg = 10
+         ELSE 
+            iyear_beg = iyear_beg + 30
+         ENDIF
+      ELSEIF (simu_type==2) THEN
+         !! 2 -- Hindcast/proj
+         iyear_beg = MOD(nyear, 100)
+         IF (iyear_beg < 20)  iyear_beg = iyear_beg + 100
+         !! JPALM -- Same than previously, if iyear_beg is out of P_cfc range,
+         !!       we want to set p_CFC to 0.00 --> set iyear_beg = 10
+         IF ((iyear_beg < 30) .OR. (iyear_beg > 115)) iyear_beg = 10             
+      ENDIF
+      !!
       IF ( nmonth <= 6 ) THEN
          iyear_beg = iyear_beg - 1
@@ -152,10 +190,13 @@
                zt2  = zt1 * zt1 
                zt3  = zt1 * zt2
-               zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3
+               zt4  = zt1 * zt3
+               zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 + sca(5,jl) * zt4
 
                !    speed transfert : formulae of wanninkhof 1992
                zv2     = wndm(ji,jj) * wndm(ji,jj)
                zsch    = zsch / 660.
-               zak_cfc = ( 0.39 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1)
+               ! AXY (25/04/17): OMIP protocol specifies lower Wanninkhof (2014) value
+               ! zak_cfc = ( 0.39 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1)
+               zak_cfc = ( 0.251 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1)
 
                ! Input function  : speed *( conc. at equil - concen at surface )
@@ -176,22 +217,59 @@
          !                                                  !----------------!
       END DO                                                !  end CFC loop  !
-      !
-      IF( lrst_trc ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'trc_sms_cfc : cumulated input function fields written in ocean restart file ',   &
-            &                    'at it= ', kt,' date= ', ndastp
-         IF(lwp) WRITE(numout,*) '~~~~'
-         DO jn = jp_cfc0, jp_cfc1
-            CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) )
-         END DO
-      ENDIF                                            
+         !
+      IF( kt == nittrc000 ) THEN
+         DO jl = 1, jp_cfc   
+             WRITE(NUMOUT,*) ' '
+             WRITE(NUMOUT,*) 'CFC interpolation verification '  !! Jpalm  
+             WRITE(NUMOUT,*) '################################## '
+             WRITE(NUMOUT,*) ' '
+               if (jl.EQ.1) then
+                   WRITE(NUMOUT,*) 'Traceur = CFC11: '
+               elseif (jl.EQ.2) then
+                   WRITE(NUMOUT,*) 'Traceur = CFC12: '
+               elseif (jl.EQ.3) then
+                   WRITE(NUMOUT,*) 'Traceur = SF6: '
+               endif
+             WRITE(NUMOUT,*) 'nyear    = ', nyear
+             WRITE(NUMOUT,*) 'nmonth   = ', nmonth
+             WRITE(NUMOUT,*) 'iyear_beg= ', iyear_beg
+             WRITE(NUMOUT,*) 'iyear_end= ', iyear_end
+             WRITE(NUMOUT,*) 'p_cfc(iyear_beg)= ',p_cfc(iyear_beg, 1, jl)
+             WRITE(NUMOUT,*) 'p_cfc(iyear_end)= ',p_cfc(iyear_end, 1, jl)
+             WRITE(NUMOUT,*) 'Im1= ',im1
+             WRITE(NUMOUT,*) 'Im2= ',im2
+             WRITE(NUMOUT,*) 'zpp_cfc = ',zpp_cfc
+             WRITE(NUMOUT,*) ' '
+         END DO  
+# if defined key_debug_medusa
+         CALL flush(numout)
+# endif
+      ENDIF
+        !
+      !IF( lrst_trc ) THEN
+      !   IF(lwp) WRITE(numout,*)
+      !   IF(lwp) WRITE(numout,*) 'trc_sms_cfc : cumulated input function fields written in ocean restart file ',   &
+      !      &                    'at it= ', kt,' date= ', ndastp
+      !   IF(lwp) WRITE(numout,*) '~~~~'
+      !   DO jn = jp_cfc0, jp_cfc1
+      !      CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) )
+      !   END DO
+      !ENDIF                                            
       !
       IF( lk_iomput ) THEN
-         CALL iom_put( "qtrCFC11"  , qtr_cfc (:,:,1) )
-         CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) )
+         IF  (iom_use("qtrCFC11"))  CALL iom_put( "qtrCFC11"  , qtr_cfc (:,:,1) )
+         IF  (iom_use("qintCFC11")) CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) )
+         IF  (iom_use("qtrCFC12"))  CALL iom_put( "qtrCFC12"  , qtr_cfc (:,:,2) )
+         IF  (iom_use("qintCFC12")) CALL iom_put( "qintCFC12" , qint_cfc(:,:,2) )
+         IF  (iom_use("qtrSF6"))    CALL iom_put( "qtrSF6"    , qtr_cfc (:,:,3) )
+         IF  (iom_use("qintSF6"))   CALL iom_put( "qintSF6"   , qint_cfc(:,:,3) )
       ELSE
          IF( ln_diatrc ) THEN
             trc2d(:,:,jp_cfc0_2d    ) = qtr_cfc (:,:,1)
             trc2d(:,:,jp_cfc0_2d + 1) = qint_cfc(:,:,1)
+            trc2d(:,:,jp_cfc0_2d + 2) = qtr_cfc (:,:,2)
+            trc2d(:,:,jp_cfc0_2d + 3) = qint_cfc(:,:,2)
+            trc2d(:,:,jp_cfc0_2d + 4) = qtr_cfc (:,:,3)
+            trc2d(:,:,jp_cfc0_2d + 5) = qint_cfc(:,:,3)
          END IF
       END IF
@@ -203,4 +281,8 @@
       END IF
       !
+# if defined key_debug_medusa
+      IF(lwp) WRITE(numout,*) '   CFC - Check: nn_timing = ', nn_timing
+      CALL flush(numout)
+# endif
       IF( nn_timing == 1 )  CALL timing_stop('trc_sms_cfc')
       !
@@ -214,5 +296,5 @@
       !! ** Purpose : sets constants for CFC model
       !!---------------------------------------------------------------------
-      INTEGER :: jn
+      INTEGER :: jl, jn, iyear_beg, iyear_tmp
 
       ! coefficient for CFC11 
@@ -223,15 +305,16 @@
       soa(2,1) =  319.6552
       soa(3,1) =  119.4471
-      soa(4,1) =  -1.39165
-
-      sob(1,1) =  -0.142382
-      sob(2,1) =   0.091459
-      sob(3,1) =  -0.0157274
-
-      ! Schmidt number 
-      sca(1,1) = 3501.8
-      sca(2,1) = -210.31
-      sca(3,1) =  6.1851
-      sca(4,1) = -0.07513
+      soa(4,1) =   -1.39165
+
+      sob(1,1) = -0.142382
+      sob(2,1) =  0.091459
+      sob(3,1) = -0.0157274
+
+      ! Schmidt number          AXY (25/04/17)
+      sca(1,1) = 3579.2       ! = 3501.8
+      sca(2,1) = -222.63      ! = -210.31
+      sca(3,1) =    7.5749    ! =    6.1851
+      sca(4,1) =   -0.14595   ! =   -0.07513
+      sca(5,1) =    0.0011874 ! = absent
 
       ! coefficient for CFC12 
@@ -242,25 +325,79 @@
       soa(2,2) =  298.9702
       soa(3,2) =  113.8049
-      soa(4,2) =  -1.39165
-
-      sob(1,2) =  -0.143566
-      sob(2,2) =   0.091015
-      sob(3,2) =  -0.0153924
-
-      ! schmidt number 
-      sca(1,2) =  3845.4 
-      sca(2,2) =  -228.95
-      sca(3,2) =  6.1908 
-      sca(4,2) =  -0.067430
-
-      IF( ln_rsttr ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) ' Read specific variables from CFC model '
-         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
-         !
-         DO jn = jp_cfc0, jp_cfc1
-            CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 
-         END DO
+      soa(4,2) =   -1.39165
+
+      sob(1,2) = -0.143566
+      sob(2,2) =  0.091015
+      sob(3,2) = -0.0153924
+
+      ! schmidt number         AXY (25/04/17)
+      sca(1,2) = 3828.1      ! = 3845.4 
+      sca(2,2) = -249.86     ! = -228.95
+      sca(3,2) =    8.7603   ! =    6.1908 
+      sca(4,2) =   -0.1716   ! =   -0.067430
+      sca(5,2) =    0.001408 ! = absent
+
+      ! coefficients for SF6   AXY (25/04/17)
+      !---------------------
+      
+      ! Solubility
+      soa(1,3) =  -80.0343
+      soa(2,3) =  117.232
+      soa(3,3) =   29.5817
+      soa(4,3) =    0.0
+
+      sob(1,3) =  0.0335183
+      sob(2,3) = -0.0373942
+      sob(3,3) =  0.00774862
+
+      ! Schmidt number
+      sca(1,3) = 3177.5
+      sca(2,3) = -200.57
+      sca(3,3) =    6.8865
+      sca(4,3) =   -0.13335
+      sca(5,3) =    0.0010877
+
+      !!---------------------------------------------
+      !! JPALM -- re-initialize CFC fields and diags if restart a CFC cycle,
+      !!       Or if out of P_cfc range
+      IF (simu_type==1) THEN
+         iyear_tmp = nyear - nyear_res  !! JPALM -- in our spin-up, nyear_res is 1000
+         iyear_beg = MOD( iyear_tmp , 90 )
+         !!---------------------------------------
+         IF ((iyear_beg > 77) .OR. (iyear_beg==0)) THEN
+            qtr_cfc(:,:,:) = 0._wp
+            IF(lwp) THEN
+               WRITE(numout,*) 
+               WRITE(numout,*) 'restart a CFC cycle or out of P_cfc year bounds zero --'
+               WRITE(numout,*) '                          --    set qtr_CFC = 0.00   --'
+               WRITE(numout,*) '                          --   set qint_CFC = 0.00   --'
+               WRITE(numout,*) '                          --   set trn(CFC) = 0.00   --'
+            ENDIF
+            qtr_cfc(:,:,:) = 0._wp
+            qint_cfc(:,:,:) = 0._wp
+            trn(:,:,:,jp_cfc0:jp_cfc1) = 0._wp
+            trb(:,:,:,jp_cfc0:jp_cfc1) = 0._wp
+         ENDIF
+      !!
+      !! 2 -- Hindcast/proj
+      ELSEIF (simu_type==2) THEN
+         iyear_beg = MOD(nyear, 100)
+         IF (iyear_beg < 20)  iyear_beg = iyear_beg + 100
+         IF ((iyear_beg < 30) .OR. (iyear_beg > 115)) THEN
+            qtr_cfc(:,:,:) = 0._wp
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) 'restart a CFC cycle or out of P_cfc year bounds zero --'
+               WRITE(numout,*) '                          --    set qtr_CFC = 0.00   --'
+               WRITE(numout,*) '                          --   set qint_CFC = 0.00   --'
+               WRITE(numout,*) '                          --   set trn(CFC) = 0.00   --'
+            ENDIF
+            qtr_cfc(:,:,:) = 0._wp
+            qint_cfc(:,:,:) = 0._wp
+            trn(:,:,:,jp_cfc0:jp_cfc1) = 0._wp
+            trb(:,:,:,jp_cfc0:jp_cfc1) = 0._wp
+         ENDIF
       ENDIF
+
       IF(lwp) WRITE(numout,*)
       !
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/IDTRA/par_idtra.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/IDTRA/par_idtra.F90	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/IDTRA/par_idtra.F90	(revision 8201)
@@ -0,0 +1,67 @@
+MODULE par_idtra
+   !!======================================================================
+   !!                        ***  par_idtra  ***
+   !! TOP :   set the IDEAL-TRACER parameters
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   USE par_pisces , ONLY : jp_pisces       !: number of tracers in PISCES
+   USE par_pisces , ONLY : jp_pisces_2d    !: number of 2D diag in PISCES
+   USE par_pisces , ONLY : jp_pisces_3d    !: number of 3D diag in PISCES
+   USE par_pisces , ONLY : jp_pisces_trd   !: number of biological diag in PISCES
+
+   USE par_medusa , ONLY : jp_medusa       !: number of tracers in MEDUSA
+   USE par_medusa , ONLY : jp_medusa_2d    !: number of 2D diag in MEDUSA
+   USE par_medusa , ONLY : jp_medusa_3d    !: number of 3D diag in MEDUSA
+   USE par_medusa , ONLY : jp_medusa_trd   !: number of biological diag in MEDUSA
+
+   IMPLICIT NONE
+
+   INTEGER, PARAMETER ::   jp_lp      =  jp_pisces     +  jp_medusa     !: cumulative number of passive tracers
+   INTEGER, PARAMETER ::   jp_lp_2d   =  jp_pisces_2d  +  jp_medusa_2d  !:
+   INTEGER, PARAMETER ::   jp_lp_3d   =  jp_pisces_3d  +  jp_medusa_3d  !:
+   INTEGER, PARAMETER ::   jp_lp_trd  =  jp_pisces_trd +  jp_medusa_trd !:
+
+#if defined key_idtra
+   !!---------------------------------------------------------------------
+   !!   'key_idtra'   :                                          Ideal tracers
+   !!---------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_idtra     = .TRUE.      !: IDEAL-TRACER flag
+   INTEGER, PUBLIC, PARAMETER ::   jp_idtra     =  1          !: number of passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_idtra_2d  =  3          !: additional 2d output arrays ('key_trc_diaadd')
+   INTEGER, PUBLIC, PARAMETER ::   jp_idtra_3d  =  0          !: additional 3d output arrays ('key_trc_diaadd')
+   INTEGER, PUBLIC, PARAMETER ::   jp_idtra_trd =  0          !: number of sms trends for IDEAL-TRACER
+
+   ! assign an index in trc arrays for each IDEAL-TRACER prognostic variables
+   INTEGER, PUBLIC, PARAMETER ::   jpidtra       = jp_lp + 1   !: IDEAL-TRACER
+#else
+   !!---------------------------------------------------------------------
+   !!   Default     :                                       No IDEAL-TRACER tracers
+   !!---------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_idtra     = .FALSE.     !: IDEAL-TRACER flag
+   INTEGER, PUBLIC, PARAMETER ::   jp_idtra     =  0          !: No IDEAL-TRACER tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_idtra_2d  =  0          !: No IDEAL-TRACER additional 2d output arrays
+   INTEGER, PUBLIC, PARAMETER ::   jp_idtra_3d  =  0          !: No IDEAL-TRACER additional 3d output arrays
+   INTEGER, PUBLIC, PARAMETER ::   jp_idtra_trd =  0          !: number of sms trends for IDEAL-TRACER
+#endif
+
+   ! Starting/ending IDEAL-TRACER do-loop indices (N.B. no IDEAL-TRACER : jp_idtra0 > jp_idtra1 the do-loop are never done)
+   INTEGER, PUBLIC, PARAMETER ::   jp_idtra0     = jp_lp + 1                !: First index of IDEAL-TRACER tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_idtra1     = jp_lp + jp_idtra         !: Last  index of IDEAL-TRACER tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_idtra0_2d  = jp_lp_2d  + 1            !: First index of IDEAL-TRACER tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_idtra1_2d  = jp_lp_2d  + jp_idtra_2d  !: Last  index of IDEAL-TRACER tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_idtra0_3d  = jp_lp_3d  + 1            !: First index of IDEAL-TRACER tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_idtra1_3d  = jp_lp_3d  + jp_idtra_3d  !: Last  index of IDEAL-TRACER tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_idtra0_trd = jp_lp_trd + 0            !: First index of IDEAL-TRACER tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_idtra1_trd = jp_lp_trd + jp_idtra_trd !: Last  index of IDEAL-TRACER tracers
+
+   !!======================================================================
+END MODULE par_idtra
+
+
+
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcice_idtra.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcice_idtra.F90	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcice_idtra.F90	(revision 8201)
@@ -0,0 +1,53 @@
+MODULE trcice_idtra
+   !!======================================================================
+   !!                         ***  MODULE trcice_idtra  ***
+   !! TOP :   Main module of the MY_TRC tracers
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code
+   !!----------------------------------------------------------------------
+#if defined key_idtra
+   !!----------------------------------------------------------------------
+   !!   'key_idtra'                                    IDEAL TRACER tracers
+   !!----------------------------------------------------------------------
+   !! trc_ice_idtra       : MY_TRC model main routine
+   !!----------------------------------------------------------------------
+   USE par_trc         ! TOP parameters
+   USE oce_trc         ! Ocean variables
+   USE trc             ! TOP variables
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_ice_ini_idtra       ! called by trcice.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_ice_ini_idtra
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_ice_idtra  ***
+      !!
+      !! ** Purpose :   main routine of MY_TRC model
+      !!
+      !! ** Method  : -
+      !!----------------------------------------------------------------------
+      !
+      !
+   END SUBROUTINE trc_ice_ini_idtra
+
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                                        No MY_TRC model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_ice_ini_idtra             ! Empty routine
+   END SUBROUTINE trc_ice_ini_idtra
+#endif
+
+   !!======================================================================
+END MODULE trcice_idtra
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcini_idtra.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcini_idtra.F90	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcini_idtra.F90	(revision 8201)
@@ -0,0 +1,105 @@
+MODULE trcini_idtra
+   !!======================================================================
+   !!                         ***  MODULE trcini_idtra  ***
+   !! TOP :   initialisation of the IDEAL-TRACER tracers
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) from trcini.idtra.h90
+   !!----------------------------------------------------------------------
+#if defined key_idtra
+   !!----------------------------------------------------------------------
+   !!   'key_idtra'                                               IDEAL-TRACER tracers
+   !!----------------------------------------------------------------------
+   !! trc_ini_idtra      : IDEAL-TRACER model initialisation
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! Ocean variables
+   USE par_trc         ! TOP parameters
+   USE trc             ! TOP variables
+   USE trcsms_idtra    ! IDEAL-TRACER sms trends
+   ! USE par_idtra       ! IDEAL-TRACER parameters
+   ! USE in_out_manager  ! I/O manager
+   ! USE lib_mpp
+   ! USE iom
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_ini_idtra   ! called by trcini.F90 module
+
+   INTEGER  ::   inum                   ! unit number
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_ini_idtra
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_ini_idtra  ***
+      !!
+      !! ** Purpose :   initialization for idtra model
+      !!
+      !! ** Method  : - Read the namidtra namelist and check the parameter values
+      !!----------------------------------------------------------------------
+      INTEGER  ::    jn, jl 
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_ini_idtra: initialisation of Ideal Tracers model'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~'
+
+      IF( trc_sms_idtra_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_ini_idtra:unable to allocate CFC arrays' )
+
+
+      ! Initialization of trn in case of  no restart
+      !----------------------------------------------
+      qtr_idtra(:,:,:) = 0._wp
+      inv_idtra(:,:,:) = 0._wp
+      IF( .NOT. ln_rsttr ) THEN
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'Initialization of id-tracers ; No restart : '
+            WRITE(numout,*) '                             ; Init field equal 1 at surface - zero elsewhere'
+            WRITE(numout,*) '                             ; qint idtra equal 0 '
+         ENDIF
+         qint_idtra(:,:,:) = 0._wp
+         DO jn = jp_idtra0, jp_idtra1
+             trn(:,:,:,jn) = 0.e0
+             trn(:,:,1,jn) = 1.0
+           IF(lwp) WRITE(numout,*) 'Idealise Tracer initialisation -- jn = ',jn
+         END DO
+      ENDIF
+
+
+      !   Ideal traceur do not need any atmospheric concentration.
+      ! We consider that sucface concentration is equal to 1,
+      ! that it is advectied within the water circulation,
+      ! and that it is regularly degraded as if it was a radiactive tracer (tricium for example)
+      ! But we can play with tha caracteristic time of
+      !--------------------------------------------------------------------
+
+
+
+      IF(lwp) WRITE(numout,*) 'Initialization of IDEAL-TRACER tracers done'
+      IF(lwp) WRITE(numout,*) ' '
+
+   END SUBROUTINE trc_ini_idtra
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                                         No IDEAL-TRACER tracers
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_ini_idtra             ! Empty routine
+
+
+   END SUBROUTINE trc_ini_idtra
+#endif
+
+   !!======================================================================
+END MODULE trcini_idtra
+                                                
+
+
+
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcnam_idtra.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcnam_idtra.F90	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcnam_idtra.F90	(revision 8201)
@@ -0,0 +1,123 @@
+MODULE trcnam_idtra
+   !!======================================================================
+   !!                         ***  MODULE trcnam_idtra  ***
+   !! TOP :   initialisation of some run parameters for IDEAL-TRACER chemical model
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) from trcnam.idtra.h90
+   !!----------------------------------------------------------------------
+#if defined key_idtra
+   !!----------------------------------------------------------------------
+   !!   'key_idtra'                                               IDEAL-TRACER tracers
+   !!----------------------------------------------------------------------
+   !! trc_nam_idtra      : IDEAL-TRACER model initialisation
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! Ocean variables
+   USE par_trc         ! TOP parameters
+   USE trc             ! TOP variables
+   USE trcsms_idtra    ! IDEAL-TRACER specific variable
+   USE iom             ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_nam_idtra   ! called by trcnam.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_nam_idtra
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_nam_idtra  ***
+      !!
+      !! ** Purpose :   Definition some run parameter for IDEAL-TRACER model
+      !!
+      !! ** Method  :   Read the namidtra namelist and check the parameter
+      !!       values called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist namidtra
+      !!----------------------------------------------------------------------
+      INTEGER  :: numnatm_ref = -1   ! Logical unit for reference ID-TRA namelist
+      INTEGER  :: numnatm_cfg = -1   ! Logical unit for configuration ID-TRA namelist
+      INTEGER  :: numonc      = -1   ! Logical unit for output namelist
+      INTEGER  :: ios                 ! Local integer output status for namelist read
+      REAL(wp) :: tmp_decay          !! Years ; half time decay of our idealize tracer
+      REAL(wp) :: TDECyr, TDEC   
+      !! ----------------------------------------------------------------
+      NAMELIST/namidtra/tmp_decay
+      !!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+      !! Jpalm -- 4-11-2014
+      !! namelist for idealize tracer
+      !! only thing in namelist is the chosen half time decay
+      !! no atmospheric conditions, cause we do impose a surface concentration of 1,
+      !! and no additionnal diagnostics, 
+      !! because the only thing we are interested in is the water mass concentration on this tracer.
+      !!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_nam_idtra: read IDEAL-TRACER namelist'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+      !!
+      !! Open the namelist file :
+      !!~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      CALL ctl_opn( numnatm_ref, 'namelist_idtra_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+      CALL ctl_opn( numnatm_cfg, 'namelist_idtra_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+      IF(lwm) CALL ctl_opn( numonc, 'output.namelist.idtra', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+      !! Read the namelists :
+      !!~~~~~~~~~~~~~~~~~~~~~~~
+      !! First namelist of our idealize tracer :
+      !! read the decay 1/2 time of our tracer, to define in the namelist.
+      !! tmp_decay = 1y ; 10y ; 100y or 1000y depending of which water mass you want to track
+      !!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+      REWIND( numnatm_ref )              ! Namelist namidtra in reference namelist : IDTRA parameters
+      READ  ( numnatm_ref, namidtra, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namidtra in reference namelist', lwp )
+
+      REWIND( numnatm_cfg )              ! Namelist namidtra in configuration namelist : IDTRA parameters
+      READ  ( numnatm_cfg, namidtra, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namidtra in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonc, namidtra )
+
+      IF(lwp) WRITE(numout,*) '   -  half time decay of our idealize tracer : ', tmp_decay
+
+      ! decroissance radioactive du traceur ideal
+      ! ---------------------------------------
+      ! TDECyr = 12.43/LOG(2.)             !! Tricium as example
+       TDECyr = tmp_decay/LOG(2.)          !! Idealise tracer -- with tmp_decay given in the idtracer namelist
+       TDEC = TDECyr*365.*24.*60.*60.      !! translate in second
+       FDEC = EXP( -rdt/TDEC )
+
+
+!! #if defined key_trc_diaadd  && ! defined key_iomput
+      !!
+      !!  -Here you can add tracers names to be read
+      !! in a namelist.
+      !!  -But this is not necessary with the iomput module
+      !! cause names are written in the Iodef file.
+      !!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+!! #endif
+
+   END SUBROUTINE trc_nam_idtra
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                                No IDEAL-TRACER
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_nam_idtra                      ! Empty routine
+   END  SUBROUTINE  trc_nam_idtra
+#endif
+
+   !!======================================================================
+END MODULE trcnam_idtra
+
+
+
+
+
+
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcsms_idtra.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcsms_idtra.F90	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcsms_idtra.F90	(revision 8201)
@@ -0,0 +1,259 @@
+MODULE trcsms_idtra
+   !!======================================================================
+   !!                      ***  MODULE trcsms_idtra  ***
+   !! TOP : TRI main model
+   !!======================================================================
+   !! History :    -   !  1999-10  (JC. Dutay)  original code
+   !!             1.0  !  2004-03 (C. Ethe) free form + modularity
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  reorganisation
+   !!----------------------------------------------------------------------
+#if defined key_idtra
+   !!----------------------------------------------------------------------
+   !!   'key_idtra'                                               TRI tracers
+   !!----------------------------------------------------------------------
+   !!   trc_sms_idtra     :  compute and add TRI suface forcing to TRI trends
+   !!   trc_idtra_cst :  sets constants for TRI surface forcing computation
+   !!----------------------------------------------------------------------
+   USE oce_trc      ! Ocean variables
+   USE par_trc      ! TOP parameters
+   USE trc          ! TOP variables
+   USE trd_oce
+   USE trdtrc
+   USE iom
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_sms_idtra        ! called in ???
+   PUBLIC   trc_sms_idtra_alloc  ! called in ???
+   !
+   INTEGER , PUBLIC    ::   nyear_res      ! restoring time constant (year)
+   INTEGER , PUBLIC    ::   numnatm
+   REAL(wp), PUBLIC    ::   FDEC
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qtr_idtra  ! flux at surface
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qint_idtra ! cumulative flux 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   inv_idtra  ! vertic. inventory
+
+   !                          ! coefficients for conversion
+   REAL(wp) ::  WTEMP
+
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_sms_idtra( kt )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_sms_idtra  ***
+      !!
+      !! ** Purpose :   Compute the surface boundary contition on TRI 11
+      !!             passive tracer associated with air-mer fluxes and add it
+      !!             to the general trend of tracers equations.
+      !!
+      !! ** Method  : - get the atmospheric partial pressure - given in pico -
+      !!              - computation of solubility ( in 1.e-12 mol/l then in 1.e-9 mol/m3)
+      !!              - computation of transfert speed ( given in cm/hour ----> cm/s )
+      !!              - the input function is given by :
+      !!                speed * ( concentration at equilibrium - concentration at surface )
+      !!              - the input function is in pico-mol/m3/s and the
+      !!                TRI concentration in pico-mol/m3
+      !!               
+      !! *** For Idealized Tracers              
+      !!              - no need for any temporal references, 
+      !!              nor any atmospheric concentration, nor air -sea fluxes
+      !!              - Here we fixe surface concentration to 1.0 Tracer-Unit/m3
+      !!              - Then we add a decay (radioactive-like) to this tracer concentration 
+      !!              - the Half life deccay is chosen by the user, depending of the experiment. 
+      !!              
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in )  ::   kt    ! ocean time-step index
+      !!
+      INTEGER                ::   ji, jj, jn, jl, jk
+      REAL(wp)               ::   rlx                 !! relaxation time (1 day)
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_sms_idtra')
+      !
+      rlx = 10./(60. * 60. * 24.)                              !! relaxation time (1/10 day)
+      IF (kt == nittrc000) THEN
+         IF(lwp) WRITE(numout,*) '   trcsms_idtra :'
+         IF(lwp) WRITE(numout,*) '   ~~~~~~~~~~~~~~~~~'
+         IF(lwp) WRITE(numout,*) '   - idtra decay factor : ', FDEC
+         IF(lwp) WRITE(numout,*) '   - relaxation time    : ', rlx
+# if defined key_debug_medusa
+         CALL flush(numout)
+# endif
+      !   CALL idtra_init
+      ENDIF
+
+         !
+      inv_idtra(:,:,:) = 0.0                                   !! init the inventory
+      qtr_idtra(:,:,:) = 0.0                                   !! init the air-sea flux
+      DO jl = 1, jp_idtra
+         jn = jp_idtra0 + jl - 1
+
+      !!   DO jj = 1, jpj
+      !!      DO ji = 1, jpi
+           DO jj = 2,jpjm1
+              DO ji = 2,jpim1
+
+         !! First, a crude version. will be much inproved later.
+             qtr_idtra(ji,jj,jl)  = rlx * (1. - trb(ji,jj,1,jn)) * tmask(ji,jj,1) *   & 
+                                  fse3t(ji,jj,1)                  !! Air-sea Flux
+
+           !! DEBUG-TEST : Set flux equal to 0, see if it induces the pb we see in the MED  
+           !!  qtr_idtra(ji,jj,jl)  = 0.0
+           ENDDO
+         ENDDO
+         tra(:,:,1,jn)      = tra(:,:,1,jn) + ( qtr_idtra(:,:,jl) *  &
+                            tmask(:,:,1) / fse3t(:,:,1) )
+         qint_idtra(:,:,jl) = qint_idtra(:,:,jl) +                   &           
+                              qtr_idtra(:,:,jl) * rdt              !! Cumulative Air-sea Flux
+
+
+         DO jk =1,jpk
+            inv_idtra(:,:,jl) = inv_idtra(:,:,jl) +                  &
+                     (trn(:,:,jk,jn) * fse3t(:,:,jk) * tmask(:,:,jk))  !! vertical inventory
+         ENDDO
+!
+!DECAY of OUR IDEALIZED TRACER
+! ---------------------------------------
+
+         DO  jk =1,jpk
+      !!      DO jj=1,jpj
+      !!        DO  ji =1,jpi
+            DO jj = 2,jpjm1
+               DO ji = 2,jpim1
+            
+                 !! IF (trn(ji,jj,jk,jn) > 0.0) THEN
+                    WTEMP = trn(ji,jj,jk,jn) * (1. - FDEC )
+                    tra(ji,jj,jk,jn) = (tra(ji,jj,jk,jn) - WTEMP/rdt ) * &
+                                     tmask(ji,jj,jk)
+                 !! ENDIF 
+              ENDDO 
+            ENDDO
+         ENDDO
+
+      ENDDO
+    !! jn loop
+!
+# if defined key_debug_medusa
+         IF(lwp) WRITE(numout,*) '   IDTRA - calculation part - DONE trc_sms_idtra -- '
+      CALL flush(numout)
+# endif
+        !
+        !! restart and diagnostics management -- 
+      !IF( lrst_trc ) THEN
+      !   IF(lwp) WRITE(numout,*)
+      !   IF(lwp) WRITE(numout,*) 'trc_sms_idtra : cumulated input function fields written in ocean restart file ',   &
+      !      &                    'at it= ', kt,' date= ', ndastp
+      !   IF(lwp) WRITE(numout,*) '~~~~'
+      !   !!DO jn = jp_idtra0, jp_idtra1
+      !      CALL iom_rstput( kt, nitrst, numrtw, 'qint_IDTRA', qint_idtra(:,:,1) )
+      !   !!END DO
+ ! if defined key_debug_medusa
+      !   IF(lwp) WRITE(numout,*) '   IDTRA - writing diag-restart - DONE trc_sms_idtra -- '
+      !   CALL flush(numout)
+ ! endif
+      !ENDIF
+      !
+      IF( lk_iomput ) THEN
+         CALL iom_put( "qtrIDTRA"  , qtr_idtra (:,:,1) )
+         CALL iom_put( "qintIDTRA" , qint_idtra(:,:,1) )
+         CALL iom_put( "invIDTRA" , inv_idtra(:,:,1) )
+      ELSE
+         IF( ln_diatrc ) THEN
+            trc2d(:,:,jp_idtra0_2d    ) = qtr_idtra (:,:,1)
+            trc2d(:,:,jp_idtra0_2d + 1) = qint_idtra(:,:,1)
+            trc2d(:,:,jp_idtra0_2d + 2) = inv_idtra(:,:,1)
+         END IF
+      END IF
+      !
+# if defined key_debug_medusa
+      IF(lwp) WRITE(numout,*) '   IDTRA - writing diag - DONE trc_sms_idtra -- '
+      CALL flush(numout)
+# endif
+      !
+      IF( l_trdtrc ) THEN
+# if defined key_debug_medusa
+         IF(lwp) WRITE(numout,*) '   IDTRA - writing trends - trc_sms_idtra -- '
+         CALL flush(numout)
+# endif
+          DO jn = jp_idtra0, jp_idtra1
+            CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt )   ! save trends
+          END DO
+# if defined key_debug_medusa
+         IF(lwp) WRITE(numout,*) '   IDTRA - writing trends - DONE trc_sms_idtra -- '
+         CALL flush(numout)
+# endif
+      END IF
+      !
+# if defined key_debug_medusa
+         IF(lwp) WRITE(numout,*) '   IDTRA - Check: nn_timing = ', nn_timing 
+         CALL flush(numout)
+# endif
+      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_idtra')
+      !
+# if defined key_debug_medusa
+         IF(lwp) WRITE(numout,*) '   IDTRA DONE trc_sms_idtra -- '
+      CALL flush(numout)
+# endif
+      !
+   END SUBROUTINE trc_sms_idtra
+
+   SUBROUTINE idtra_init
+      !!---------------------------------------------------------------------
+      !!                     ***  idtra_init  ***
+      !!
+      !! ** Purpose : read restart values for IDTRA model
+      !!---------------------------------------------------------------------
+      INTEGER :: jn
+
+      IF( ln_rsttr ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' Read specific variables from Ideal Tracers model '
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+         !
+         DO jn = jp_idtra0, jp_idtra1
+            CALL iom_get( numrtr, jpdom_autoglo, 'qint_IDTRA', qint_idtra(:,:,jn) )
+         END DO
+      ENDIF
+      IF(lwp) WRITE(numout,*) 'idtra restart variables read -- OK'
+      !
+   END SUBROUTINE idtra_init
+
+   INTEGER FUNCTION trc_sms_idtra_alloc()
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_sms_idtra_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( qtr_idtra (jpi,jpj,jp_idtra) ,     &
+         &      inv_idtra(jpi,jpj,jp_idtra)  ,     &
+         &      qint_idtra(jpi,jpj,jp_idtra) , STAT=trc_sms_idtra_alloc )
+         !
+      IF( trc_sms_idtra_alloc /= 0 ) CALL ctl_warn('trc_sms_idtra_alloc : failed to allocate arrays.')
+      !
+   END FUNCTION trc_sms_idtra_alloc
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                                         No TRI tracers
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_sms_idtra( kt )       ! Empty routine
+      WRITE(*,*) 'trc_sms_idtra: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_sms_idtra
+#endif
+
+   !!======================================================================
+END MODULE trcsms_idtra
+
+
+
+
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcwri_idtra.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcwri_idtra.F90	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcwri_idtra.F90	(revision 8201)
@@ -0,0 +1,63 @@
+MODULE trcwri_idtra
+   !!======================================================================
+   !!                       *** MODULE trcwri ***
+   !!    IDEALIZED Tracer :   Output of IDEALIZED Tracer tracers
+   !!======================================================================
+   !! History :   1.0  !  2009-05 (C. Ethe)  Original code
+   !!             1.1  !  2013-05 (A. Yool)  converted for MEDUSA
+   !!----------------------------------------------------------------------
+#if defined key_top && defined key_iomput && defined key_idtra
+   !!----------------------------------------------------------------------
+   !!   'key_idtra'                                           IDEALIZED Tracer model
+   !!----------------------------------------------------------------------
+   !! trc_wri_idtra   :  outputs of concentration fields
+   !!----------------------------------------------------------------------
+   ! USE oce_trc         ! Ocean variables
+   ! USE par_trc         ! TOP parameters
+   USE trc             ! passive tracers common variables
+   ! USE trcsms_idtra    ! IDEALIZE TRACER sms trends
+   USE iom             ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC trc_wri_idtra
+
+CONTAINS
+
+   SUBROUTINE trc_wri_idtra
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_wri_trc  ***
+      !!
+      !! ** Purpose :   output passive tracers fields 
+      !!---------------------------------------------------------------------
+      CHARACTER (len=20)   :: cltra
+      INTEGER              :: jn
+      !!---------------------------------------------------------------------
+
+      ! write the tracer concentrations in the file
+      ! ---------------------------------------
+      DO jn = jp_idtra0, jp_idtra1
+         cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer
+         CALL iom_put( cltra, trn(:,:,:,jn) )
+      END DO
+      !
+   END SUBROUTINE trc_wri_idtra
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+   PUBLIC trc_wri_idtra
+CONTAINS
+   SUBROUTINE trc_wri_idtra                     ! Empty routine  
+   END SUBROUTINE trc_wri_idtra
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE trcwri_idtra
+
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/gas_transfer.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/gas_transfer.F90	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/gas_transfer.F90	(revision 8201)
@@ -0,0 +1,154 @@
+MODULE gastransfer
+   !!======================================================================
+   !!                         ***  MODULE trcdms_medusa  ***
+   !! TOP :   MEDUSA
+   !!======================================================================
+   !! History :
+   !!  -   !  2015-06  (A. Yool)             added for UKESM1 project
+   !!----------------------------------------------------------------------
+#if defined key_medusa && defined key_roam
+      USE oce_trc
+      USE trc
+      USE sms_medusa
+      USE lbclnk
+      USE prtctl_trc      ! Print control for debugging
+      USE in_out_manager  ! I/O manager
+
+      IMPLICIT NONE
+      PRIVATE
+
+      PUBLIC   gas_transfer  ! called by trcbio_medusa.F90 module
+
+   !!* Substitution
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+      subroutine gas_transfer(wind, N, eqn, kw660)
+! --------------------------------------------------------------------
+!  Gas transfer velocity
+! --------------------------------------------------------------------
+!
+! Title  : Calculates gas transfer velocity
+! Author : Andrew Yool
+! Date   : 15/10/04
+! 
+! This subroutine uses near-surface wind speed to calculate gas
+! transfer velocity for use in CO2 and O2 exchange calculations.
+!
+! Note that the parameterisation of Wanninkhof quoted here is a
+! truncation of the original equation.  It excludes a chemical
+! enhancement function (based on temperature), although such
+! temperature dependence is reported negligible by Etcheto & 
+! Merlivat (1988).
+!
+! Note also that in calculating scalar wind, the variance of the
+! wind over the period of a timestep is ignored.  Some authors,
+! for instance OCMIP-2, favour including some reference to the
+! variability of wind.  However, their wind fields are averaged
+! over relatively long time periods, and so this issue may be
+! safely (!) ignored here.
+! 
+! AXY (12/06/2015)
+! UPDATED: revised formulation from Wanninkhof (2014) update to
+! original 1992 paper. Full reference is:
+!
+! Wanninkhof, R. (2014). Relationship between wind speed and gas 
+! exchange over the ocean revisited. LIMNOLOGY AND OCEANOGRAPHY-METHODS
+! 12, 351-362, doi:10.4319/lom.2014.12.351
+! 
+! Subroutine inputs are (in order) : 
+!     wind      wind velocity at 10 m (m/s)
+!     N         size of input array (value 1 at this time)
+!     eqn       choice of parameterisation:
+!               1 = Liss & Merlivat (1986)    [approximated]
+!               2 = Wanninkhof (1992)         [sans enhancement]
+!               3 = Nightingale et al. (2000) [good]
+!               4 = Nightingale et al. (2000) [better]
+!               5 = Nightingale et al. (2000) [best]
+!               6 = OCMIP-2                   [sans variability]
+!               7 = Wanninkhof (2014)         [assumes 6h avg winds]
+! (*) k         gas transfer velocity (m/s)
+! 
+! Where (*) is the function output and (+) is a diagnostic output.
+!
+      implicit none
+
+      INTEGER, INTENT(in) :: N, eqn
+! Input variables
+!     real(kind=wp), INTENT(in),  DIMENSION(N) :: wind
+      real(wp), INTENT(in)  :: wind
+!
+! Output variables
+!     real(kind=wp), INTENT(out), DIMENSION(N) :: kw660
+      real(wp), INTENT(out) :: kw660
+!
+!     INTEGER :: eqn
+!
+! Coefficients for various parameterisations
+      real(wp) :: a(7)
+      real(wp) :: b(7)
+!
+!     real(wp), DIMENSION(N) :: tmp_k
+      real(wp) :: tmp_k
+!
+! Values of coefficients
+      data a(1) / 0.166 /  ! Liss & Merlivat (1986)    [approximated]
+      data a(2) / 0.3   /  ! Wanninkhof (1992)         [sans enhancement]
+      data a(3) / 0.23  /  ! Nightingale et al. (2000) [good]
+      data a(4) / 0.23  /  ! Nightingale et al. (2000) [better]
+      data a(5) / 0.222 /  ! Nightingale et al. (2000) [best]
+      data a(6) / 0.337 /  ! OCMIP-2                   [sans variability]
+      data a(7) / 0.251 /  ! Wanninkhof (2014)         [assumes 6h avg winds]
+!
+      data b(1) / 0.133 /
+      data b(2) / 0.0   /
+      data b(3) / 0.0   /
+      data b(4) / 0.1   /
+      data b(5) / 0.333 /
+      data b(6) / 0.0   /
+      data b(7) / 0.0   /
+!
+! Which parameterisation is to be used?
+!     eqn = 7
+!
+! Calculate gas transfer velocity (cm/h)
+      tmp_k = (a(eqn) * wind**2) + (b(eqn) * wind)
+!
+! Convert tmp_k from cm/h to m/s
+      kw660 = tmp_k / (100. * 3600.)
+!
+      return
+
+    end subroutine gas_transfer
+
+!=======================================================================
+!=======================================================================
+!=======================================================================
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No MEDUSA bio-model
+   !!======================================================================
+
+CONTAINS
+
+   SUBROUTINE gas_transfer(wind, N, eqn, kw660)
+      USE par_kind
+
+      REAL(wp), INTENT( in )    :: wind
+      REAL(wp), INTENT( in )    :: kw660
+      INTEGER, INTENT(in) :: N, eqn
+
+      WRITE(*,*) 'gas_transfer: You should not have seen this print! error?', kt
+
+   END SUBROUTINE gas_transfer
+#endif
+
+   !!======================================================================
+END MODULE gastransfer
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/mocsy_gasflux.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/mocsy_gasflux.F90	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/mocsy_gasflux.F90	(revision 8201)
@@ -0,0 +1,242 @@
+MODULE mocsy_gasflux
+
+CONTAINS
+
+! --------------------------------------------------------------------
+!  Schmidt CO2 number
+! --------------------------------------------------------------------
+!
+! Title  : Calculates Schmidt number for ocean uptake of CO2
+! Author : Andrew Yool
+! Date   : 14/10/04
+!
+! This function calculates the Schmidt number for CO2 using sea surface
+! temperature.  The code is based upon that developed as part of the
+! OCMIP-2 project (1998-2000).  The coefficients used are taken from
+! Wanninkhof (1992, JGR, 97, 7373-7382).
+!
+! AXY (12/06/2015)
+! UPDATED: coefficients used below are now those from Wanninkhof (2014)
+! update to original 1992 paper. Full reference is:
+!
+! Winninkhof, R. (2014). Relationship between wind speed and gas 
+! exchange over the ocean revisited. LIMNOLOGY AND OCEANOGRAPHY-METHODS
+! 12, 351-362, doi:10.4319/lom.2014.12.351
+!
+! Check answer for the function at 20 degrees C is 668.
+!
+! Function inputs are (in order) :
+!     t            temperature (degrees C)
+! (*) co2_schmidt  carbon dioxide Schmidt number
+!
+! Where (*) is the function output.
+!
+      subroutine schmidt_co2(pt, N, co2_schmidt)
+
+      USE mocsy_singledouble
+
+      implicit none
+!
+      INTEGER, INTENT(in) :: N
+      real(kind=wp), INTENT(in),  DIMENSION(N) :: pt
+      real(kind=wp), INTENT(out), DIMENSION(N) :: co2_schmidt
+!
+      real(kind=wp)              :: a0, a1, a2, a3, a4
+!
+!     data a0 /    2073.1 /
+!     data a1 /   -125.62 /
+!     data a2 /    3.6276 /
+!     data a3 / -0.043219 /
+!
+      data a0 /    2116.8 /
+      data a1 /   -136.25 /
+      data a2 /    4.7353 /
+      data a3 / -0.092307 /
+      data a4 / 0.0007555 /
+!
+! Wanninkhof (1992)
+!     co2_schmidt = a0 + pt*(a1 + pt*(a2 + pt*a3))
+!
+! Wanninkhof (2014) adds in an extra term
+      co2_schmidt = a0 + pt*(a1 + pt*(a2 + pt*(a3 + pt*a4)))
+!
+      return
+
+      end subroutine schmidt_co2
+
+! --------------------------------------------------------------------
+!  Surface K0
+! --------------------------------------------------------------------
+!
+! Title  : Calculates surface K0 from surface T & S
+! Author : Andrew Yool
+! Date   : 18/06/15
+!
+! This function is derived from code included in the MOCSY package
+! produced by Jim Orr.
+!
+      subroutine surface_K0(ptmp, saln, N, K0)
+
+      USE mocsy_singledouble
+
+      implicit none
+!
+      INTEGER, INTENT(in) :: N
+      real(kind=wp), INTENT(in),  DIMENSION(N) :: ptmp, saln
+      real(kind=wp), INTENT(out), DIMENSION(N) :: K0
+!
+      real(kind=wp), DIMENSION(N) :: tk, invtk, tmp
+      real(kind=wp)               :: a0, a1, a2, a3, a4
+!
+      tk    = ptmp + 273.15d0
+      invtk = 1.0d0 / tk
+      tmp = (9345.17d0*invtk) - 60.2409d0 + (23.3585d0 * LOG(tk/100.0d0))
+      K0 = EXP( tmp + saln*(0.023517d0 - (0.00023656d0*tk) + (0.0047036e-4_wp*tk*tk)) )
+!
+      return
+
+      end subroutine surface_K0
+
+! --------------------------------------------------------------------
+!  Calculate xCO2
+! --------------------------------------------------------------------
+!
+!>    Compute xCO2 from arrays of pCO2atm, in situ T, S, & atm pressure
+SUBROUTINE pCO2atm2xCO2(pCO2atm, temp, salt, Patm, N, xCO2)
+  !    Purpose:
+  !    Compute xCO2 from arrays of pCO2atm, in situ T, S, & atm pressure
+
+  USE mocsy_singledouble
+
+  IMPLICIT NONE
+
+  !> number of records
+  INTEGER, intent(in) :: N
+
+! INPUT variables
+  !> atmospheric partial pressure of CO2 [uatm] 
+  ! AXY (22/06/15): amended this next line to "in" as that's what it should be!
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: pCO2atm
+  !> in situ temperature [C]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: temp
+  !> salinity [psu]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: salt
+  !> atmospheric pressure [atm]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: Patm
+!f2py optional , depend(temp) :: n=len(temp)
+
+! OUTPUT variables:
+  !> mole fraction of CO2 [ppm]
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: xCO2
+
+! LOCAL variables:
+  REAL(kind=wp) :: dpCO2atm, dPatm
+  REAL(kind=wp), DIMENSION(N) :: pH20
+  REAL(kind=wp) :: dxCO2
+
+  INTEGER :: i
+
+  call vapress(temp, salt, N, pH20)
+
+  DO i = 1,N
+     dpCO2atm  = DBLE(pCO2atm(i))
+     dPatm     = DBLE(Patm(i))
+     dxCO2     = dpCO2atm / (dPatm - pH20(i))
+     xCO2(i) = REAL(dxCO2)
+  END DO
+
+  RETURN
+END SUBROUTINE pCO2atm2xCO2
+
+! --------------------------------------------------------------------
+!  Calculate pCO2atm
+! --------------------------------------------------------------------
+!
+!>    Compute pCO2atm from arrays of xCO2, in situ T, S, & atm pressure
+SUBROUTINE x2pCO2atm(xCO2, temp, salt, Patm, N, pCO2atm)
+  !    Purpose:
+  !    Compute pCO2atm from arrays of xCO2, in situ T, S, & atm pressure
+
+  USE mocsy_singledouble
+
+  IMPLICIT NONE
+
+  !> number of records
+  INTEGER, intent(in) :: N
+
+! INPUT variables
+  !> mole fraction of CO2 [ppm]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: xCO2
+  !> in situ temperature [C]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: temp
+  !> salinity [psu]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: salt
+  !> atmospheric pressure [atm]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: Patm
+!f2py optional , depend(temp) :: n=len(temp)
+
+! OUTPUT variables:
+  !> oceanic partial pressure of CO2 [uatm] 
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: pCO2atm
+
+! LOCAL variables:
+  REAL(kind=wp) :: dxCO2, dPatm
+  REAL(kind=wp), DIMENSION(N) :: pH20
+  REAL(kind=wp) :: dpCO2atm
+
+  INTEGER :: i
+
+! Compute vapor pressure of seawater [in atm]
+  call vapress(temp, salt, N, pH20)
+
+  DO i = 1,N
+     dxCO2     = DBLE(xCO2(i))
+     dPatm     = DBLE(Patm(i))
+     dpCO2atm = (dPatm - pH20(i)) * dxCO2
+     pCO2atm(i) = REAL(dpCO2atm)
+  END DO
+
+  RETURN
+END SUBROUTINE x2pCO2atm
+
+! --------------------------------------------------------------------
+!  Calculate seawater vapor pressure
+! --------------------------------------------------------------------
+!
+!>    Compute vapor pressure of seawater (atm) following preocedure from Weiss & Price (1980)
+SUBROUTINE vapress(temp, salt, N, vpsw)
+  !    Purpose:
+  !    Compute vapor pressure of seawater (atm) following preocedure from Weiss & Price (1980)
+
+  USE mocsy_singledouble
+  IMPLICIT NONE
+
+  !> number of records
+  INTEGER, intent(in) :: N
+
+! INPUT variables
+  !> in situ temperature [C]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: temp
+  !> salinity [psu]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: salt
+!f2py optional , depend(temp) :: n=len(temp)
+
+! OUTPUT variables:
+  !> vapor pressure of seawater [atm] 
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: vpsw
+
+! LOCAL variables:
+  REAL(kind=wp) :: tk, dsalt
+
+  INTEGER :: i
+
+  DO i = 1,N
+     dsalt = DBLE(salt(i))
+     tk = 273.15d0 + DBLE(temp(i))     !Absolute temperature (Kelvin)
+     vpsw(i) = exp(24.4543d0 - 67.4509d0*(100.0d0/tk) - 4.8489d0*log(tk/100) - 0.000544d0*dsalt)
+  END DO
+
+  RETURN
+END SUBROUTINE vapress
+
+END MODULE mocsy_gasflux
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/mocsy_mainmod.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/mocsy_mainmod.F90	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/mocsy_mainmod.F90	(revision 8201)
@@ -0,0 +1,2061 @@
+MODULE mocsy_mainmod
+
+      USE in_out_manager  ! I/O manager
+
+CONTAINS
+
+! ----------------------------------------------------------------------
+!  SW_ADTG
+! ----------------------------------------------------------------------
+!
+!> \file sw_adtg.f90
+!! \BRIEF 
+!> Module with sw_adtg function - compute adiabatic temp. gradient from S,T,P
+!>  Function to calculate adiabatic temperature gradient as per UNESCO 1983 routines.
+FUNCTION sw_adtg  (s,t,p)
+
+  !     ==================================================================
+  !     Calculates adiabatic temperature gradient as per UNESCO 1983 routines.
+  !     Armin Koehl akoehl@ucsd.edu
+  !     ==================================================================
+  USE mocsy_singledouble
+  IMPLICIT NONE
+  !> salinity [psu (PSU-78)]
+  REAL(kind=wp) :: s
+  !> temperature [degree C (IPTS-68)]
+  REAL(kind=wp) :: t
+  !> pressure [db]
+  REAL(kind=wp) :: p
+
+  REAL(kind=wp) :: a0,a1,a2,a3,b0,b1,c0,c1,c2,c3,d0,d1,e0,e1,e2
+  REAL(kind=wp) :: sref
+
+  REAL(kind=wp) :: sw_adtg
+
+  sref = 35.d0
+  a0 =  3.5803d-5
+  a1 = +8.5258d-6
+  a2 = -6.836d-8
+  a3 =  6.6228d-10
+
+  b0 = +1.8932d-6
+  b1 = -4.2393d-8
+
+  c0 = +1.8741d-8
+  c1 = -6.7795d-10
+  c2 = +8.733d-12
+  c3 = -5.4481d-14
+
+  d0 = -1.1351d-10
+  d1 =  2.7759d-12
+
+  e0 = -4.6206d-13
+  e1 = +1.8676d-14
+  e2 = -2.1687d-16
+
+  sw_adtg =  a0 + (a1 + (a2 + a3*T)*T)*T &
+       + (b0 + b1*T)*(S-sref) &
+       + ( (c0 + (c1 + (c2 + c3*T)*T)*T) + (d0 + d1*T)*(S-sref) )*P &
+       + (  e0 + (e1 + e2*T)*T )*P*P
+
+END FUNCTION sw_adtg
+
+! ----------------------------------------------------------------------
+!  SW_ADTG
+! ----------------------------------------------------------------------
+!
+!> \file sw_ptmp.f90
+!! \BRIEF 
+!> Module with sw_ptmp function - compute potential T from in-situ T
+!> Function to calculate potential temperature [C] from in-situ temperature
+FUNCTION sw_ptmp  (s,t,p,pr)
+
+  !     ==================================================================
+  !     Calculates potential temperature [C] from in-situ Temperature [C]
+  !     From UNESCO 1983 report.
+  !     Armin Koehl akoehl@ucsd.edu
+  !     ==================================================================
+
+  !     Input arguments:
+  !     -------------------------------------
+  !     s  = salinity            [psu      (PSS-78) ]
+  !     t  = temperature         [degree C (IPTS-68)]
+  !     p  = pressure            [db]
+  !     pr = reference pressure  [db]
+
+  USE mocsy_singledouble
+  IMPLICIT NONE
+
+! Input arguments
+  !> salinity [psu (PSS-78)]
+  REAL(kind=wp) :: s
+  !> temperature [degree C (IPTS-68)]
+  REAL(kind=wp) :: t
+  !> pressure [db]
+  REAL(kind=wp) :: p
+  !> reference pressure  [db]  
+  REAL(kind=wp) :: pr
+
+! local arguments
+  REAL(kind=wp) :: del_P ,del_th, th, q
+  REAL(kind=wp) :: onehalf, two, three
+  PARAMETER (onehalf = 0.5d0, two = 2.d0, three = 3.d0 )
+
+! REAL(kind=wp) :: sw_adtg
+! EXTERNAL sw_adtg
+
+! Output 
+  REAL(kind=wp) :: sw_ptmp
+
+  ! theta1
+  del_P  = PR - P
+  del_th = del_P*sw_adtg(S,T,P)
+  th     = T + onehalf*del_th
+  q      = del_th
+
+  ! theta2
+  del_th = del_P*sw_adtg(S,th,P+onehalf*del_P)
+  th     = th + (1.d0 - 1.d0/SQRT(two))*(del_th - q)
+  q      = (two-SQRT(two))*del_th + (-two+three/SQRT(two))*q
+
+  ! theta3
+  del_th = del_P*sw_adtg(S,th,P+onehalf*del_P)
+  th     = th + (1.d0 + 1.d0/SQRT(two))*(del_th - q)
+  q      = (two + SQRT(two))*del_th + (-two-three/SQRT(two))*q
+
+  ! theta4
+  del_th = del_P*sw_adtg(S,th,P+del_P)
+  sw_ptmp     = th + (del_th - two*q)/(two*three)
+
+  RETURN
+END FUNCTION sw_ptmp
+
+
+! ----------------------------------------------------------------------
+!  SW_TEMP
+! ----------------------------------------------------------------------
+!
+!> \file sw_temp.f90
+!! \BRIEF 
+!> Module with sw_temp function - compute in-situ T from potential T
+!> Function to compute in-situ temperature [C] from potential temperature [C]
+FUNCTION sw_temp( s, t, p, pr )
+  !     =============================================================
+  !     SW_TEMP
+  !     Computes in-situ temperature [C] from potential temperature [C]
+  !     Routine available in seawater.f (used for MIT GCM)
+  !     Downloaded seawater.f (on 17 April 2009) from
+  !     http://ecco2.jpl.nasa.gov/data1/beaufort/MITgcm/bin/
+  !     =============================================================
+
+  !     REFERENCES:
+  !     Fofonoff, P. and Millard, R.C. Jr
+  !     Unesco 1983. Algorithms for computation of fundamental properties of
+  !     seawater, 1983. _Unesco Tech. Pap. in Mar. Sci._, No. 44, 53 pp.
+  !     Eqn.(31) p.39
+
+  !     Bryden, H. 1973.
+  !     "New Polynomials for thermal expansion, adiabatic temperature gradient
+  !     and potential temperature of sea water."
+  !     DEEP-SEA RES., 1973, Vol20,401-408.
+  !     =============================================================
+
+  !     Simple modifications: J. C. Orr, 16 April 2009
+  !     - combined fortran code from MITgcm site & simplification in
+  !       CSIRO code (matlab equivalent) from Phil Morgan
+
+  USE mocsy_singledouble
+  IMPLICIT NONE
+
+  !     Input arguments:
+  !     -----------------------------------------------
+  !     s  = salinity              [psu      (PSS-78) ]
+  !     t  = potential temperature [degree C (IPTS-68)]
+  !     p  = pressure              [db]
+  !     pr = reference pressure    [db]
+
+  !> salinity [psu (PSS-78)]
+  REAL(kind=wp) ::   s
+  !> potential temperature [degree C (IPTS-68)]
+  REAL(kind=wp) ::   t
+  !> pressure [db]
+  REAL(kind=wp) ::   p
+  !> reference pressure [db]
+  REAL(kind=wp) ::   pr
+
+  REAL(kind=wp) ::  ds, dt, dp, dpr
+  REAL(kind=wp) :: dsw_temp
+
+  REAL(kind=wp) ::   sw_temp
+! EXTERNAL sw_ptmp
+! REAL(kind=wp) ::   sw_ptmp
+
+  ds = DBLE(s)
+  dt = DBLE(t)
+  dp = DBLE(p)
+  dpr = DBLE(pr)
+
+  !    Simple solution
+  !    (see https://svn.mpl.ird.fr/us191/oceano/tags/V0/lib/matlab/seawater/sw_temp.m)
+  !    Carry out inverse calculation by swapping P_ref (pr) and Pressure (p)
+  !    in routine that is normally used to compute potential temp from temp
+  dsw_temp = sw_ptmp(ds, dt, dpr, dp)
+  sw_temp = REAL(dsw_temp)
+
+  !    The above simplification works extremely well (compared to Table in 1983 report)
+  !    whereas the sw_temp routine from MIT GCM site does not seem to work right
+
+  RETURN
+END FUNCTION sw_temp
+
+! ----------------------------------------------------------------------
+!  TPOT
+! ----------------------------------------------------------------------
+!
+!> \file tpot.f90
+!! \BRIEF 
+!>    Module with tpot subroutine - compute potential T from in situ T,S,P
+!>    Compute potential temperature from arrays of in situ temp, salinity, and pressure.
+!!    This subroutine is needed because sw_ptmp is a function (using scalars not arrays)
+SUBROUTINE tpot(salt, tempis, press, pressref, N, tempot)
+  !    Purpose:
+  !    Compute potential temperature from arrays of in situ temp, salinity, and pressure.
+  !    Needed because sw_ptmp is a function
+
+  USE mocsy_singledouble
+  IMPLICIT NONE
+
+  !> number of records
+  INTEGER, intent(in) :: N
+
+! INPUT variables
+  !> salinity [psu]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: salt
+  !> in situ temperature [C]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: tempis
+  !> pressure [db]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: press
+!f2py optional , depend(salt) :: n=len(salt)
+  !> pressure reference level [db]
+  REAL(kind=wp), INTENT(in) :: pressref
+
+! OUTPUT variables:
+  !> potential temperature [C] for pressref
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: tempot
+
+  REAL(kind=wp) :: dsalt, dtempis, dpress, dpressref
+  REAL(kind=wp) :: dtempot
+
+  INTEGER :: i
+
+! REAL(kind=wp) :: sw_ptmp
+! EXTERNAL sw_ptmp
+
+  DO i = 1,N
+     dsalt     = DBLE(salt(i))
+     dtempis   = DBLE(tempis(i))
+     dpress    = DBLE(press(i))
+     dpressref = DBLE(pressref)
+
+     dtempot   = sw_ptmp(dsalt, dtempis, dpress, dpressref)
+
+     tempot(i) = REAL(dtempot)
+  END DO
+
+  RETURN
+END SUBROUTINE tpot
+
+! ----------------------------------------------------------------------
+!  TIS
+! ----------------------------------------------------------------------
+!
+!> \file tis.f90
+!! \BRIEF 
+!>    Module with tis subroutine - compute in situ T from S,T,P
+!>    Compute in situ temperature from arrays of potential temp, salinity, and pressure.
+!!    This subroutine is needed because sw_temp is a function (using scalars not arrays)
+SUBROUTINE tis(salt, tempot, press, pressref, N, tempis)
+  !    Purpose:
+  !    Compute in situ temperature from arrays of in situ temp, salinity, and pressure.
+  !    Needed because sw_temp is a function
+
+  USE mocsy_singledouble
+  IMPLICIT NONE
+
+  !> number of records
+  INTEGER, intent(in) :: N
+
+! INPUT variables
+  !> salinity [psu]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: salt
+  !> potential temperature [C]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: tempot
+  !> pressure [db]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: press
+!f2py optional , depend(salt) :: n=len(salt)
+  !> pressure reference level [db]
+  REAL(kind=wp), INTENT(in) :: pressref
+
+! OUTPUT variables:
+  !> in situ temperature [C] 
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: tempis
+
+! REAL(kind=wp) :: dsalt, dtempis, dpress, dpressref
+! REAL(kind=wp) :: dtempot
+
+  INTEGER :: i
+
+! REAL(kind=wp) :: sw_temp
+! REAL(kind=wp) :: sw_temp
+! EXTERNAL sw_temp
+
+  DO i = 1,N
+    !dsalt     = DBLE(salt(i))
+    !dtempot   = DBLE(tempot(i))
+    !dpress    = DBLE(press(i))
+    !dpressref = DBLE(pressref)
+    !dtempis   = sw_temp(dsalt, dtempot, dpress, dpressref)
+    !tempis(i) = REAL(dtempis)
+
+     tempis   = sw_temp(salt(i), tempot(i), press(i), pressref)
+  END DO
+
+  RETURN
+END SUBROUTINE tis
+
+! ----------------------------------------------------------------------
+!  P80
+! ----------------------------------------------------------------------
+!
+!> \file p80.f90
+!! \BRIEF 
+!> Module with p80 function - compute pressure from depth
+!>     Function to compute pressure from depth using Saunder's (1981) formula with eos80.
+FUNCTION p80(dpth,xlat)
+
+  !     Compute Pressure from depth using Saunder's (1981) formula with eos80.
+
+  !     Reference:
+  !     Saunders, Peter M. (1981) Practical conversion of pressure
+  !     to depth, J. Phys. Ooceanogr., 11, 573-574, (1981)
+
+  !     Coded by:
+  !     R. Millard
+  !     March 9, 1983
+  !     check value: p80=7500.004 dbars at lat=30 deg., depth=7321.45 meters
+
+  !     Modified (slight format changes + added ref. details):
+  !     J. Orr, 16 April 2009
+
+  USE mocsy_singledouble
+  IMPLICIT NONE
+
+! Input variables:
+  !> depth [m]
+  REAL(kind=wp), INTENT(in) :: dpth
+  !> latitude [degrees]
+  REAL(kind=wp), INTENT(in) :: xlat
+
+! Output variable:
+  !> pressure [db]
+  REAL(kind=wp) :: p80
+
+! Local variables:
+  REAL(kind=wp) :: pi
+  REAL(kind=wp) :: plat, d, c1
+
+  pi=3.141592654
+
+  plat = ABS(xlat*pi/180.)
+  d  = SIN(plat)
+  c1 = 5.92e-3+d**2 * 5.25e-3
+
+  p80 = ((1-c1)-SQRT(((1-c1)**2)-(8.84e-6*dpth))) / 4.42e-6
+
+  RETURN
+END FUNCTION p80
+
+! ----------------------------------------------------------------------
+!  RHO
+! ----------------------------------------------------------------------
+!
+!> \file rho.f90
+!! \BRIEF 
+!> Module with rho function - computes in situ density from S, T, P
+!> Function to compute in situ density from salinity (psu), in situ temperature (C), & pressure (bar)
+FUNCTION rho(salt, temp, pbar)
+
+  ! Compute in situ density from salinity (psu), in situ temperature (C), & pressure (bar)
+
+  USE mocsy_singledouble
+  IMPLICIT NONE
+
+  !> salinity [psu]
+  REAL(kind=wp) :: salt
+  !> in situ temperature (C)
+  REAL(kind=wp) :: temp
+  !> pressure (bar) [Note units: this is NOT in decibars]
+  REAL(kind=wp) :: pbar
+
+  REAL(kind=wp) :: s, t, p
+! REAL(kind=wp) :: t68
+  REAL(kind=wp) :: X
+  REAL(kind=wp) :: rhow, rho0
+  REAL(kind=wp) :: a, b, c
+  REAL(kind=wp) :: Ksbmw, Ksbm0, Ksbm
+  REAL(kind=wp) :: drho
+
+  REAL(kind=wp) :: rho
+
+  !     Input arguments:
+  !     -------------------------------------
+  !     s  = salinity            [psu      (PSS-78) ]
+  !     t  = in situ temperature [degree C (IPTS-68)]
+  !     p  = pressure            [bar] !!!!  (not in [db]
+
+  s = DBLE(salt)
+  t = DBLE(temp)
+  p = DBLE(pbar)
+
+! Convert the temperature on today's "ITS 90" scale to older IPTS 68 scale
+! (see Dickson et al., Best Practices Guide, 2007, Chap. 5, p. 7, including footnote)
+! According to Best-Practices guide, line above should be commented & 2 lines below should be uncommented
+! Guide's answer of rho (s=35, t=25, p=0) = 1023.343 is for temperature given on ITPS-68 scale
+! t68 = (T - 0.0002) / 0.99975
+! X = t68
+! Finally, don't do the ITS-90 to IPTS-68 conversion (T input var now already on IPTS-68 scale)
+  X = T
+
+! Density of pure water
+  rhow = 999.842594d0 + 6.793952e-2_wp*X          &
+       -9.095290e-3_wp*X*X + 1.001685e-4_wp*X**3  &
+       -1.120083e-6_wp*X**4 + 6.536332e-9_wp*X**5
+
+! Density of seawater at 1 atm, P=0
+  A = 8.24493e-1_wp - 4.0899e-3_wp*X                         &
+       + 7.6438e-5_wp*X*X - 8.2467e-7_wp*X**3 + 5.3875e-9_wp*X**4
+  B = -5.72466e-3_wp + 1.0227e-4_wp*X - 1.6546e-6_wp*X*X
+  C = 4.8314e-4_wp
+
+  rho0 = rhow + A*S + B*S*SQRT(S) + C*S**2.0d0
+
+! Secant bulk modulus of pure water
+! The secant bulk modulus is the average change in pressure
+! divided by the total change in volume per unit of initial volume.
+  Ksbmw = 19652.21d0 + 148.4206d0*X - 2.327105d0*X*X &
+       + 1.360477e-2_wp*X**3 - 5.155288e-5_wp*X**4
+
+! Secant bulk modulus of seawater at 1 atm
+  Ksbm0 = Ksbmw + S*( 54.6746d0 - 0.603459d0*X + 1.09987e-2_wp*X**2 &
+       - 6.1670e-5_wp*X**3) &
+       + S*SQRT(S)*( 7.944e-2_wp + 1.6483e-2_wp*X - 5.3009e-4_wp*X**2)
+
+! Secant bulk modulus of seawater at S,T,P
+  Ksbm = Ksbm0 &
+       + P*(3.239908d0 + 1.43713e-3_wp*X + 1.16092e-4_wp*X**2 - 5.77905e-7_wp*X**3) &
+       + P*S*(2.2838e-3_wp - 1.0981e-5_wp*X - 1.6078e-6_wp*X**2) &
+       + P*S*SQRT(S)*1.91075e-4_wp &
+       + P*P*(8.50935e-5_wp - 6.12293e-6_wp*X + 5.2787e-8_wp*X**2) &
+       + P*P*S*(-9.9348e-7_wp + 2.0816e-8_wp*X + 9.1697e-10_wp*X**2)
+
+! Density of seawater at S,T,P
+  drho = rho0/(1.0d0 - P/Ksbm)
+  rho = REAL(drho)
+
+  RETURN
+END FUNCTION rho
+
+! ----------------------------------------------------------------------
+!  RHOINSITU
+! ----------------------------------------------------------------------
+!
+!> \file rhoinsitu.f90
+!! \BRIEF 
+!> Module with rhoinsitu subroutine - compute in situ density from S, Tis, P
+!>     Compute in situ density from salinity (psu), in situ temperature (C), & pressure (db).
+!!     This subroutine is needed because rho is a function (using scalars not arrays)
+SUBROUTINE rhoinsitu(salt, tempis, pdbar, N, rhois)
+
+  !     Purpose:
+  !     Compute in situ density from salinity (psu), in situ temperature (C), & pressure (db)
+  !     Needed because rho is a function
+
+  USE mocsy_singledouble
+  IMPLICIT NONE
+
+  INTEGER :: N
+
+! INPUT variables
+  ! salt   = salinity [psu]
+  ! tempis = in situ temperature [C]
+  ! pdbar  = pressure [db]
+
+  !> salinity [psu]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: salt
+  !> in situ temperature [C]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: tempis
+  !> pressure [db]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: pdbar
+!f2py optional , depend(salt) :: n=len(salt)
+
+! OUTPUT variables:
+  ! rhois  = in situ density
+
+  !> in situ density [kg/m3]
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: rhois
+
+! Local variables
+  INTEGER :: i
+
+! REAL(kind=wp) ::  rho
+! EXTERNAL rho
+
+  DO i = 1,N
+     rhois(i) = rho(salt(i), tempis(i), pdbar(i)/10.)
+  END DO
+
+  RETURN
+END SUBROUTINE rhoinsitu
+
+! ----------------------------------------------------------------------
+!  DEPTH2PRESS
+! ----------------------------------------------------------------------
+!
+!> \file depth2press.f90
+!! \BRIEF 
+!> Module with depth2press subroutine - converts depth to pressure
+!! with Saunders (1981) formula
+!>     Compute pressure [db] from depth [m] & latitude [degrees north].
+!!     This subroutine is needed because p80 is a function (using scalars not arrays)
+SUBROUTINE depth2press(depth, lat, pdbar, N)
+
+  !     Purpose:
+  !     Compute pressure [db] from depth [m] & latitude [degrees north].
+  !     Needed because p80 is a function 
+
+  USE mocsy_singledouble
+  IMPLICIT NONE
+
+  !> number of records
+  INTEGER, intent(in) :: N
+
+! INPUT variables
+  !> depth [m]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: depth
+  !> latitude [degrees]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: lat
+!f2py optional , depend(depth) :: n=len(depth)
+
+! OUTPUT variables:
+  !> pressure [db]
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: pdbar
+
+  !     Local variables
+  INTEGER :: i
+
+! REAL(kind=wp) ::  p80
+! EXTERNAL p80
+
+  DO i = 1,N
+     pdbar(i) = p80(depth(i), lat(i))
+  END DO
+
+  RETURN
+END SUBROUTINE depth2press
+
+! ----------------------------------------------------------------------
+!  CONSTANTS
+! ----------------------------------------------------------------------
+!
+!> \file constants.f90
+!! \BRIEF 
+!> Module with contants subroutine - computes carbonate system constants
+!! from S,T,P 
+!> Compute thermodynamic constants
+!! FROM temperature, salinity, and pressure (1D arrays)
+SUBROUTINE constants(K0, K1, K2, Kb, Kw, Ks, Kf, Kspc, Kspa,  &
+                     K1p, K2p, K3p, Ksi,                      &
+                     St, Ft, Bt,                              &
+                     temp, sal, Patm,                         &
+                     depth, lat, N,                           &
+                     optT, optP, optB, optK1K2, optKf, optGAS)
+
+  !   Purpose:
+  !     Compute thermodynamic constants
+  !     FROM: temperature, salinity, and pressure (1D arrays)
+
+  !     INPUT variables:
+  !     ================
+  !     Patm    = atmospheric pressure [atm]
+  !     depth   = depth [m]     (with optP='m', i.e., for a z-coordinate model vertical grid is depth, not pressure)
+  !             = pressure [db] (with optP='db')
+  !     lat     = latitude [degrees] (needed to convert depth to pressure, i.e., when optP='m')
+  !             = dummy array (unused when optP='db')
+  !     temp    = potential temperature [degrees C] (with optT='Tpot', i.e., models carry tempot, not temp)
+  !             = in situ   temperature [degrees C] (with optT='Tinsitu', e.g., for data)
+  !     sal     = salinity in [psu]
+  !     ---------
+  !     optT: choose in situ vs. potential temperature as input
+  !     ---------
+  !     NOTE: Carbonate chem calculations require IN-SITU temperature (not potential Temperature)
+  !       -> 'Tpot' means input is pot. Temperature (in situ Temp "tempis" is computed)
+  !       -> 'Tinsitu' means input is already in-situ Temperature, not pot. Temp ("tempis" not computed)
+  !     ---------
+  !     optP: choose depth (m) vs pressure (db) as input
+  !     ---------
+  !       -> 'm'  means "depth" input is in "m" (thus in situ Pressure "p" [db] is computed)
+  !       -> 'db' means "depth" input is already in situ pressure [db], not m (p = depth)
+  !     ---------
+  !     optB:
+  !     ---------
+  !       -> 'u74' means use classic formulation of Uppström (1974) for total Boron
+  !       -> 'l10' means use newer   formulation of Lee et al. (2010) for total Boron
+  !     ---------
+  !     optK1K2:
+  !     ---------
+  !       -> 'l'   means use Lueker et al. (2000) formulations for K1 & K2 (recommended by Dickson et al. 2007)
+  !                **** BUT this should only be used when 2 < T < 35 and 19 < S < 43
+  !       -> 'm10' means use Millero (2010) formulation for K1 & K2 (see Dickson et al., 2007)
+  !                **** Valid for 0 < T < 50°C and 1 < S < 50 psu
+  !       -> 'w14' means use Waters (2014) formulation for K1 & K2 (see Dickson et al., 2007)
+  !                **** Valid for 0 < T < 50°C and 1 < S < 50 psu
+  !     -----------
+  !     optKf:
+  !     ----------
+  !       -> 'pf' means use Perez & Fraga (1987) formulation for Kf (recommended by Dickson et al., 2007)
+  !               **** BUT Valid for  9 < T < 33°C and 10 < S < 40.
+  !       -> 'dg' means use Dickson & Riley (1979) formulation for Kf (recommended by Dickson & Goyet, 1994)
+  !     -----------
+  !     optGAS: choose in situ vs. potential fCO2 and pCO2
+  !     ---------
+  !       PRESSURE corrections for K0 and the fugacity coefficient (Cf) 
+  !       -> 'Pzero'   = 'zero order' fCO2 and pCO2 (typical approach, which is flawed)
+  !                      considers in situ T & only atm pressure (hydrostatic=0)
+  !       -> 'Ppot'    = 'potential' fCO2 and pCO2 (water parcel brought adiabatically to the surface)
+  !                      considers potential T & only atm pressure (hydrostatic press = 0)
+  !       -> 'Pinsitu' = 'in situ' fCO2 and pCO2 (accounts for huge effects of pressure)
+  !                      considers in situ T & total pressure (atm + hydrostatic)
+  !     ---------
+
+  !     OUTPUT variables:
+  !     =================
+  !     K0, K1, K2, Kb, Kw, Ks, Kf, Kspc, Kspa, K1p, K2p, K3p, Ksi
+  !     St, Ft, Bt
+
+  USE mocsy_singledouble
+  IMPLICIT NONE
+
+! Input variables
+  !>     number of records
+  INTEGER, INTENT(in) :: N
+  !> in <b>situ temperature</b> (when optT='Tinsitu', typical data) 
+  !! OR <b>potential temperature</b> (when optT='Tpot', typical models) [degree C]
+  REAL(kind=wp), INTENT(in),    DIMENSION(N) :: temp
+  !> depth in <b>meters</b> (when optP='m') or <b>decibars</b> (when optP='db')
+  REAL(kind=wp), INTENT(in),    DIMENSION(N) :: depth
+  !> latitude <b>[degrees north]</b>
+  REAL(kind=wp), INTENT(in),    DIMENSION(N) :: lat
+  !> salinity <b>[psu]</b>
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: sal
+!f2py optional , depend(sal) :: n=len(sal)
+
+  !> atmospheric pressure <b>[atm]</b>
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: Patm
+
+  !> for temp input, choose \b 'Tinsitu' for in situ Temp or 
+  !! \b 'Tpot' for potential temperature (in situ Temp is computed, needed for models)
+  CHARACTER(7), INTENT(in) :: optT
+  !> for depth input, choose \b "db" for decibars (in situ pressure) or \b "m" for meters (pressure is computed, needed for models)
+  CHARACTER(2), INTENT(in) :: optP
+  !> for total boron, choose either \b 'u74' (Uppstrom, 1974) or \b 'l10' (Lee et al., 2010).
+  !! The 'l10' formulation is based on 139 measurements (instead of 20),
+  !! uses a more accurate method, and
+  !! generally increases total boron in seawater by 4% 
+!f2py character*3 optional, intent(in) :: optB='l10'
+  CHARACTER(3), OPTIONAL, INTENT(in) :: optB
+  !> for Kf, choose either \b 'pf' (Perez & Fraga, 1987) or \b 'dg' (Dickson & Riley, 1979)
+!f2py character*2 optional, intent(in) :: optKf='pf'
+  CHARACTER(2), OPTIONAL, INTENT(in) :: optKf
+  !> for K1,K2 choose either \b 'l' (Lueker et al., 2000) or \b 'm10' (Millero, 2010) or \b 'w14' (Waters et al., 2014)
+!f2py character*3 optional, intent(in) :: optK1K2='l'
+  CHARACTER(3), OPTIONAL, INTENT(in) :: optK1K2
+  !> for K0,fugacity coefficient choose either \b 'Ppot' (no pressure correction) or \b 'Pinsitu' (with pressure correction) 
+  !! 'Ppot'    - for 'potential' fCO2 and pCO2 (water parcel brought adiabatically to the surface)
+  !! 'Pinsitu' - for 'in situ' values of fCO2 and pCO2, accounting for pressure on K0 and Cf
+  !! with 'Pinsitu' the fCO2 and pCO2 will be many times higher in the deep ocean
+!f2py character*7 optional, intent(in) :: optGAS='Pinsitu'
+  CHARACTER(7), OPTIONAL, INTENT(in) :: optGAS
+
+! Ouput variables
+  !> solubility of CO2 in seawater (Weiss, 1974), also known as K0
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: K0
+  !> K1 for the dissociation of carbonic acid from Lueker et al. (2000) or Millero (2010), depending on optK1K2
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: K1
+  !> K2 for the dissociation of carbonic acid from Lueker et al. (2000) or Millero (2010), depending on optK1K2
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: K2
+  !> equilibrium constant for dissociation of boric acid 
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: Kb
+  !> equilibrium constant for the dissociation of water (Millero, 1995)
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: Kw
+  !> equilibrium constant for the dissociation of bisulfate (Dickson, 1990)
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: Ks
+  !> equilibrium constant for the dissociation of hydrogen fluoride 
+  !! either from Dickson and Riley (1979) or from Perez and Fraga (1987), depending on optKf
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: Kf
+  !> solubility product for calcite (Mucci, 1983)
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: Kspc
+  !> solubility product for aragonite (Mucci, 1983)
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: Kspa
+  !> 1st dissociation constant for phosphoric acid (Millero, 1995)
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: K1p
+  !> 2nd dissociation constant for phosphoric acid (Millero, 1995)
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: K2p
+  !> 3rd dissociation constant for phosphoric acid (Millero, 1995)
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: K3p
+  !> equilibrium constant for the dissociation of silicic acid (Millero, 1995)
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: Ksi
+  !> total sulfate (Morris & Riley, 1966)
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: St
+  !> total fluoride  (Riley, 1965)
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: Ft
+  !> total boron
+  !! from either Uppstrom (1974) or Lee et al. (2010), depending on optB
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: Bt
+
+! Local variables
+  REAL(kind=wp) :: ssal
+  REAL(kind=wp) :: p
+  REAL(kind=wp) :: tempot, tempis68, tempot68
+  REAL(kind=wp) :: tempis
+  REAL(kind=wp) :: is, invtk, dlogtk, is2, s2, sqrtis
+  REAL(kind=wp) :: Ks_0p, Kf_0p
+  REAL(kind=wp) :: total2free, free2SWS, total2SWS, SWS2total
+  REAL(kind=wp) :: total2free_0p, free2SWS_0p, total2SWS_0p
+! REAL(kind=wp) :: free2SWS, free2SWS_0p
+
+  REAL(kind=wp) :: dtempot, dtempot68
+  REAL(kind=wp) :: R
+
+  REAL(kind=wp) :: pK1o, ma1, mb1, mc1, pK1
+  REAL(kind=wp) :: pK2o, ma2, mb2, mc2, pK2
+
+  REAL(kind=wp), DIMENSION(12) :: a0, a1, a2, b0, b1, b2
+  REAL(kind=wp), DIMENSION(12) :: deltav, deltak, lnkpok0
+  REAL(kind=wp) :: tmp, nK0we74
+
+  INTEGER :: i, icount, ipc
+
+  REAL(kind=wp) :: t, tk, tk0, prb
+  REAL(kind=wp) :: s, sqrts, s15, scl
+
+  REAL(kind=wp) :: Phydro_atm, Patmd, Ptot, Rgas_atm, vbarCO2
+
+! Arrays to pass optional arguments into or use defaults (Dickson et al., 2007)
+  CHARACTER(3) :: opB
+  CHARACTER(2) :: opKf
+  CHARACTER(3) :: opK1K2
+  CHARACTER(7) :: opGAS
+
+  ! CONSTANTS
+  ! =========
+  ! Constants in formulation for Pressure effect on K's (Millero, 95)
+  ! with corrected coefficients for Kb, Kw, Ksi, etc.
+
+  ! index: 1) K1 , 2) K2, 3) Kb, 4) Kw, 5) Ks, 6) Kf, 7) Kspc, 8) Kspa,
+  !            9) K1P, 10) K2P, 11) K3P, 12) Ksi
+
+  DATA a0 /-25.5_wp, -15.82_wp, -29.48_wp, -20.02_wp, &
+          -18.03_wp,  -9.78_wp, -48.76_wp, -45.96_wp, &
+          -14.51_wp, -23.12_wp, -26.57_wp, -29.48_wp/
+  DATA a1 /0.1271_wp, -0.0219_wp, 0.1622_wp, 0.1119_wp, &
+           0.0466_wp, -0.0090_wp, 0.5304_wp, 0.5304_wp, &
+           0.1211_wp, 0.1758_wp, 0.2020_wp, 0.1622_wp/
+  DATA a2 /     0.0_wp,       0.0_wp, -2.608e-3_wp, -1.409e-3_wp, &
+           0.316e-3_wp, -0.942e-3_wp,  0.0_wp,       0.0_wp, &
+          -0.321e-3_wp, -2.647e-3_wp, -3.042e-3_wp, -2.6080e-3_wp/
+  DATA b0 /-3.08e-3_wp, 1.13e-3_wp,  -2.84e-3_wp,   -5.13e-3_wp, &
+           -4.53e-3_wp, -3.91e-3_wp, -11.76e-3_wp, -11.76e-3_wp, &
+           -2.67e-3_wp, -5.15e-3_wp,  -4.08e-3_wp,  -2.84e-3_wp/
+  DATA b1 /0.0877e-3_wp, -0.1475e-3_wp, 0.0_wp,       0.0794e-3_wp, &
+           0.09e-3_wp,    0.054e-3_wp,  0.3692e-3_wp, 0.3692e-3_wp, &
+           0.0427e-3_wp,  0.09e-3_wp,   0.0714e-3_wp, 0.0_wp/
+  DATA b2 /12*0.0_wp/
+
+! Set defaults for optional arguments (in Fortran 90)
+! Note:  Optional arguments with f2py (python) are set above with 
+!        the !f2py statements that precede each type declaraion
+  IF (PRESENT(optB)) THEN
+    opB = optB
+  ELSE
+    opB = 'l10'
+  ENDIF
+  IF (PRESENT(optKf)) THEN
+    opKf = optKf
+  ELSE
+    opKf = 'pf'
+  ENDIF
+  IF (PRESENT(optK1K2)) THEN
+    opK1K2 = optK1K2
+  ELSE
+    opK1K2 = 'l'
+  ENDIF
+  IF (PRESENT(optGAS)) THEN
+    opGAS = optGAS
+  ELSE
+    opGAS = 'Pinsitu'
+  ENDIF
+
+  R = 83.14472_wp
+
+  icount = 0
+  DO i = 1, N
+     icount = icount + 1
+!    ===============================================================
+!    Convert model depth -> press; convert model Theta -> T in situ
+!    ===============================================================
+!    * Model temperature tracer is usually "potential temperature"
+!    * Model vertical grid is usually in meters
+!    BUT carbonate chem routines require pressure & in-situ T
+!    Thus before computing chemistry, if appropriate,
+!    convert these 2 model vars (input to this routine)
+!     - depth [m] => convert to pressure [db]
+!     - potential temperature (C) => convert to in-situ T (C)
+!    -------------------------------------------------------
+!    1)  Compute pressure [db] from depth [m] and latitude [degrees] (if input is m, for models)
+     IF (trim(optP) == 'm' ) THEN
+!       Compute pressure [db] from depth [m] and latitude [degrees]
+        p = p80(depth(i), lat(i))
+     ELSEIF (trim(optP) == 'db' ) THEN
+!       In this case (where optP = 'db'), p is input & output (no depth->pressure conversion needed)
+        p = depth(i)
+     ELSE
+        PRINT *,"optP must be 'm' or 'db'"
+        STOP
+     ENDIF
+
+!    2) Convert potential T to in-situ T (if input is Tpot, i.e. case for models):
+     IF (trim(optT) == 'Tpot' .OR. trim(optT) == 'tpot') THEN
+        tempot = temp(i)
+!       This is the case for most models and some data
+!       a) Convert the pot. temp on today's "ITS 90" scale to older IPTS 68 scale
+!          (see Dickson et al., Best Practices Guide, 2007, Chap. 5, p. 7, including footnote)
+        tempot68 = (tempot - 0.0002) / 0.99975
+!       b) Compute "in-situ Temperature" from "Potential Temperature" (both on IPTS 68)
+        tempis68 = sw_temp(sal(i), tempot68, p, 0.0_wp )
+!       c) Convert the in-situ temp on older IPTS 68 scale to modern scale (ITS 90)
+        tempis = 0.99975*tempis68 + 0.0002
+!       Note: parts (a) and (c) above are tiny corrections;
+!             part  (b) is a big correction for deep waters (but zero at surface)
+     ELSEIF (trim(optT) == 'Tinsitu' .OR. trim(optT) == 'tinsitu') THEN
+!       When optT = 'Tinsitu', tempis is input & output (no tempot needed)
+        tempis    = temp(i)
+        tempis68  = (temp(i) - 0.0002) / 0.99975
+!       dtempot68 = sw_ptmp(DBLE(sal(i)), DBLE(tempis68), DBLE(p), 0.0_wp)
+        dtempot68 = sw_ptmp(sal(i), tempis68, p, 0.0_wp)
+        dtempot   = 0.99975*dtempot68 + 0.0002
+     ELSE
+        PRINT *,"optT must be either 'Tpot' or 'Tinsitu'"
+        PRINT *,"you specified optT =", trim(optT) 
+        STOP
+     ENDIF
+
+!    Compute constants:
+     IF (temp(i) >= -5. .AND. temp(i) < 1.0e+2) THEN
+!       Test to indicate if any of input variables are unreasonable
+        IF (      sal(i) < 0.  .OR.  sal(i) > 1e+3) THEN
+           PRINT *, 'i, icount, temp, sal =', i, icount, temp(i), sal(i)
+        ENDIF
+!       Zero out negative salinity (prev case for OCMIP2 model w/ slightly negative S in some coastal cells)
+        IF (sal(i) < 0.0) THEN
+           ssal = 0.0
+        ELSE
+           ssal = sal(i)
+        ENDIF
+
+!       Absolute temperature (Kelvin) and related values
+        t = DBLE(tempis)
+        tk = 273.15d0 + t
+        invtk=1.0d0/tk
+        dlogtk=LOG(tk)
+
+!       Atmospheric pressure
+        Patmd = DBLE(Patm(i))
+
+!       Hydrostatic pressure (prb is in bars)
+        prb = DBLE(p) / 10.0d0
+
+!       Salinity and simply related values
+        s = DBLE(ssal)
+        s2=s*s
+        sqrts=SQRT(s)
+        s15=s**1.5d0
+        scl=s/1.80655d0
+
+!       Ionic strength:
+        is = 19.924d0*s/(1000.0d0 - 1.005d0*s)
+        is2 = is*is
+        sqrtis = SQRT(is)
+
+!       Total concentrations for sulfate, fluoride, and boron
+
+!       Sulfate: Morris & Riley (1966)
+        St(i) = 0.14d0 * scl/96.062d0
+
+!       Fluoride:  Riley (1965)
+        Ft(i) = 0.000067d0 * scl/18.9984d0
+
+!       Boron:
+        IF (trim(opB) == 'l10') THEN
+!          New formulation from Lee et al (2010)
+           Bt(i) = 0.0002414d0 * scl/10.811d0
+        ELSEIF (trim(opB) == 'u74') THEN
+!          Classic formulation from Uppström (1974)
+           Bt(i) = 0.000232d0  * scl/10.811d0
+        ELSE
+           PRINT *,"optB must be 'l10' or 'u74'"
+           STOP
+        ENDIF
+
+!       K0 (K Henry)
+!       CO2(g) <-> CO2(aq.)
+!       K0  = [CO2]/ fCO2
+!       Weiss (1974)   [mol/kg/atm]
+        IF     (trim(opGAS) == 'Pzero'   .OR. trim(opGAS) == 'pzero') THEN
+           tk0 = tk                   !in situ temperature (K) for K0 calculation
+           Ptot = Patmd               !total pressure (in atm) = atmospheric pressure ONLY
+        ELSEIF (trim(opGAS) == 'Ppot'    .OR. trim(opGAS) == 'ppot') THEN
+           tk0 = dtempot + 273.15d0   !potential temperature (K) for K0 calculation as needed for potential fCO2 & pCO2
+           Ptot = Patmd               !total pressure (in atm) = atmospheric pressure ONLY
+        ELSEIF (trim(opGAS) == 'Pinsitu' .OR. trim(opGAS) == 'pinsitu') THEN
+           tk0 = tk                     !in situ temperature (K) for K0 calculation
+           Phydro_atm = prb / 1.01325d0 !convert hydrostatic pressure from bar to atm (1.01325 bar / atm)
+           Ptot = Patmd + Phydro_atm    !total pressure (in atm) = atmospheric pressure + hydrostatic pressure
+        ELSE
+           PRINT *, "optGAS must be 'Pzero', 'Ppot', or 'Pinsitu'"
+           STOP
+        ENDIF
+        tmp = 9345.17d0/tk0 - 60.2409d0 + 23.3585d0 * LOG(tk0/100.0d0)
+        nK0we74 = tmp + s*(0.023517d0 - 0.00023656d0*tk0 + 0.0047036e-4_wp*tk0*tk0)
+        K0(i) = EXP(nK0we74)
+
+!       K1 = [H][HCO3]/[H2CO3]
+!       K2 = [H][CO3]/[HCO3]
+        IF (trim(opK1K2) == 'l') THEN
+!         Mehrbach et al. (1973) refit, by Lueker et al. (2000) (total pH scale)
+          K1(i) = 10.0d0**(-1.0d0*(3633.86d0*invtk - 61.2172d0 + 9.6777d0*dlogtk  &
+                  - 0.011555d0*s + 0.0001152d0*s2))
+          K2(i) = 10.0d0**(-1*(471.78d0*invtk + 25.9290d0 - 3.16967d0*dlogtk      &
+                  - 0.01781d0*s + 0.0001122d0*s2))
+        ELSEIF (trim(opK1K2) == 'm10') THEN
+!         Millero (2010, Mar. Fresh Wat. Res.) (seawater pH scale)
+          pK1o = 6320.813d0*invtk + 19.568224d0*dlogtk -126.34048d0
+          ma1 = 13.4038d0*sqrts + 0.03206d0*s - (5.242e-5)*s2
+          mb1 = -530.659d0*sqrts - 5.8210d0*s
+          mc1 = -2.0664d0*sqrts
+          pK1 = pK1o + ma1 + mb1*invtk + mc1*dlogtk
+          K1(i) = 10.0d0**(-pK1) 
+
+          pK2o = 5143.692d0*invtk + 14.613358d0*dlogtk -90.18333d0
+          ma2 = 21.3728d0*sqrts + 0.1218d0*s - (3.688e-4)*s2
+          mb2 = -788.289d0*sqrts - 19.189d0*s
+          mc2 = -3.374d0*sqrts
+          pK2 = pK2o + ma2 + mb2*invtk + mc2*dlogtk
+          K2(i) = 10.0d0**(-pK2)
+        ELSEIF (trim(opK1K2) == 'w14') THEN
+!         Waters, Millero, Woosley (Mar. Chem., 165, 66-67, 2014) (seawater scale)
+          pK1o = 6320.813d0*invtk + 19.568224d0*dlogtk -126.34048d0
+          ma1 = 13.409160d0*sqrts + 0.031646d0*s - (5.1895e-5)*s2
+          mb1 = -531.3642d0*sqrts - 5.713d0*s
+          mc1 = -2.0669166d0*sqrts
+          pK1 = pK1o + ma1 + mb1*invtk + mc1*dlogtk
+          K1(i) = 10.0d0**(-pK1) 
+
+          pK2o = 5143.692d0*invtk + 14.613358d0*dlogtk -90.18333d0
+          ma2 = 21.225890d0*sqrts + 0.12450870d0*s - (3.7243e-4_r8)*s2
+          mb2 = -779.3444d0*sqrts - 19.91739d0*s
+          mc2 = -3.3534679d0*sqrts
+          pK2 = pK2o + ma2 + mb2*invtk + mc2*dlogtk
+          K2(i) = 10.0d0**(-pK2)
+        ELSE
+           PRINT *, "optK1K2 must be either 'l' or 'm10', or 'w14'"
+           STOP
+        ENDIF
+
+!       Kb = [H][BO2]/[HBO2]
+!       (total scale)
+!       Millero p.669 (1995) using data from Dickson (1990)
+        Kb(i) = EXP((-8966.90d0 - 2890.53d0*sqrts - 77.942d0*s +  &
+                1.728d0*s15 - 0.0996d0*s2)*invtk +              &
+                (148.0248d0 + 137.1942d0*sqrts + 1.62142d0*s) +   &
+                (-24.4344d0 - 25.085d0*sqrts - 0.2474d0*s) *      &
+                dlogtk + 0.053105d0*sqrts*tk)
+
+!       K1p = [H][H2PO4]/[H3PO4]
+!       (seawater scale)
+!       DOE(1994) eq 7.2.20 with footnote using data from Millero (1974)
+!       Millero (1995), p.670, eq. 65
+!       Use Millero equation's 115.540 constant instead of 115.525 (Dickson et al., 2007).
+!       The latter is only an crude approximation to convert to Total scale (by subtracting 0.015)
+!       And we want to stay on the SWS scale anyway for the pressure correction later.
+        K1p(i) = EXP(-4576.752d0*invtk + 115.540d0 - 18.453d0*dlogtk +  &
+                 (-106.736d0*invtk + 0.69171d0) * sqrts +             &
+                 (-0.65643d0*invtk - 0.01844d0) * s)
+
+!       K2p = [H][HPO4]/[H2PO4]
+!       (seawater scale)
+!       DOE(1994) eq 7.2.23 with footnote using data from Millero (1974))
+!       Millero (1995), p.670, eq. 66
+!       Use Millero equation's 172.1033 constant instead of 172.0833 (Dickson et al., 2007).
+!       The latter is only an crude approximation to convert to Total scale (by subtracting 0.015)
+!       And we want to stay on the SWS scale anyway for the pressure correction later.
+        K2p(i) = EXP(-8814.715d0*invtk + 172.1033d0 - 27.927d0*dlogtk +  &
+                 (-160.340d0*invtk + 1.3566d0)*sqrts +                 &
+                 (0.37335d0*invtk - 0.05778d0)*s)
+
+!       K3p = [H][PO4]/[HPO4]
+!       (seawater scale)
+!       DOE(1994) eq 7.2.26 with footnote using data from Millero (1974)
+!       Millero (1995), p.670, eq. 67
+!       Use Millero equation's 18.126 constant instead of 18.141 (Dickson et al., 2007).
+!       The latter is only an crude approximation to convert to Total scale (by subtracting 0.015)
+!       And we want to stay on the SWS scale anyway for the pressure correction later.
+        K3p(i) = EXP(-3070.75d0*invtk - 18.126d0 +            &
+                 (17.27039d0*invtk + 2.81197d0) *             &
+                 sqrts + (-44.99486d0*invtk - 0.09984d0) * s)
+
+!       Ksi = [H][SiO(OH)3]/[Si(OH)4]
+!       (seawater scale)
+!       Millero (1995), p.671, eq. 72
+!       Use Millero equation's 117.400 constant instead of 117.385 (Dickson et al., 2007).
+!       The latter is only an crude approximation to convert to Total scale (by subtracting 0.015)
+!       And we want to stay on the SWS scale anyway for the pressure correction later.
+        Ksi(i) = EXP(-8904.2d0*invtk  + 117.400d0 - 19.334d0*dlogtk +  &
+                 (-458.79d0*invtk + 3.5913d0) * sqrtis +             &
+                 (188.74d0*invtk - 1.5998d0) * is +                  &
+                 (-12.1652d0*invtk + 0.07871d0) * is2 +              &
+                 LOG(1.0 - 0.001005d0*s))
+
+!       Kw = [H][OH]
+!       (seawater scale)
+!       Millero (1995) p.670, eq. 63 from composite data
+!       Use Millero equation's 148.9802 constant instead of 148.9652 (Dickson et al., 2007).
+!       The latter is only an crude approximation to convert to Total scale (by subtracting 0.015)
+!       And we want to stay on the SWS scale anyway for the pressure correction later.
+        Kw(i) = EXP(-13847.26d0*invtk + 148.9802d0 - 23.6521d0*dlogtk +  &
+               (118.67d0*invtk - 5.977d0 + 1.0495d0 * dlogtk) *          &
+               sqrts - 0.01615d0 * s)
+
+!       Ks = [H][SO4]/[HSO4]
+!       (free scale)
+!       Dickson (1990, J. chem. Thermodynamics 22, 113)
+        Ks_0p = EXP(-4276.1d0*invtk + 141.328d0 - 23.093d0*dlogtk          &
+                + (-13856.d0*invtk + 324.57d0 - 47.986d0*dlogtk) * sqrtis  &
+                + (35474.d0*invtk - 771.54 + 114.723d0*dlogtk) * is      &
+                - 2698.d0*invtk*is**1.5 + 1776.d0*invtk*is2              &
+                + LOG(1.0d0 - 0.001005d0*s))
+
+!       Kf = [H][F]/[HF]
+!       (total scale)
+        IF (trim(opKf) == 'dg') THEN
+!          Dickson and Riley (1979) -- change pH scale to total (following Dickson & Goyet, 1994)
+           Kf_0p = EXP(1590.2d0*invtk - 12.641d0 + 1.525d0*sqrtis +  &
+                   LOG(1.0d0 - 0.001005d0*s) +                     &
+                   LOG(1.0d0 + St(i)/Ks_0p))
+        ELSEIF (trim(opKf) == 'pf') THEN
+!          Perez and Fraga (1987) - Already on Total scale (no need for last line above)
+!          Formulation as given in Dickson et al. (2007)
+           Kf_0p = EXP(874.d0*invtk - 9.68d0 + 0.111d0*sqrts)
+        ELSE
+           PRINT *, "optKf must be either 'dg' or 'pf'"
+           STOP
+        ENDIF
+
+!       Kspc (calcite) - apparent solubility product of calcite
+!       (no scale)
+!       Kspc = [Ca2+] [CO32-] when soln is in equilibrium w/ calcite
+!       Mucci 1983 mol/kg-soln
+        Kspc(i) = 10d0**(-171.9065d0 - 0.077993d0*tk + 2839.319d0/tk    &
+                 + 71.595d0*LOG10(tk)                             &
+                 + (-0.77712d0 + 0.0028426d0*tk + 178.34d0/tk)*sqrts  &
+                 -0.07711d0*s + 0.0041249d0*s15 )
+
+
+!       Kspa (aragonite) - apparent solubility product of aragonite
+!       (no scale)
+!       Kspa = [Ca2+] [CO32-] when soln is in equilibrium w/ aragonite
+!       Mucci 1983 mol/kg-soln
+        Kspa(i) = 10.d0**(-171.945d0 - 0.077993d0*tk + 2903.293d0/tk &
+             +71.595d0*LOG10(tk) &
+             +(-0.068393d0 + 0.0017276d0*tk + 88.135d0/tk)*sqrts &
+             -0.10018d0*s + 0.0059415d0*s15 )
+
+!       Pressure effect on K0 based on Weiss (1974, equation 5)
+        Rgas_atm = 82.05736_wp      ! (cm3 * atm) / (mol * K)  CODATA (2006)
+        vbarCO2 = 32.3_wp           ! partial molal volume (cm3 / mol) from Weiss (1974, Appendix, paragraph 3)
+        K0(i) = K0(i) * exp( ((1-Ptot)*vbarCO2)/(Rgas_atm*tk0) )   ! Weiss (1974, equation 5)
+
+!       Pressure effect on all other K's (based on Millero, (1995)
+!           index: K1(1), K2(2), Kb(3), Kw(4), Ks(5), Kf(6), Kspc(7), Kspa(8),
+!                  K1p(9), K2p(10), K3p(11), Ksi(12)
+        DO ipc = 1, 12
+           deltav(ipc)  =  a0(ipc) + a1(ipc) *t + a2(ipc) *t*t
+           deltak(ipc)   = (b0(ipc)  + b1(ipc) *t + b2(ipc) *t*t)
+           lnkpok0(ipc)  = (-(deltav(ipc)) &
+                +(0.5d0*deltak(ipc) * prb) &
+                )                         * prb/(R*tk)
+        END DO
+
+!       Pressure correction on Ks (Free scale)
+        Ks(i) = Ks_0p*EXP(lnkpok0(5))
+!       Conversion factor total -> free scale
+        total2free     = 1.d0/(1.d0 + St(i)/Ks(i))   ! Kfree = Ktotal*total2free
+!       Conversion factor total -> free scale at pressure zero
+        total2free_0p  = 1.d0/(1.d0 + St(i)/Ks_0p)   ! Kfree = Ktotal*total2free
+
+!       Pressure correction on Kf
+!       Kf must be on FREE scale before correction
+        Kf_0p = Kf_0p * total2free_0p   !Convert from Total to Free scale (pressure 0)
+        Kf(i) = Kf_0p * EXP(lnkpok0(6)) !Pressure correction (on Free scale)
+        Kf(i) = Kf(i)/total2free        !Convert back from Free to Total scale
+
+!       Convert between seawater and total hydrogen (pH) scales
+        free2SWS  = 1.d0 + St(i)/Ks(i) + Ft(i)/(Kf(i)*total2free)  ! using Kf on free scale
+        total2SWS = total2free * free2SWS                          ! KSWS = Ktotal*total2SWS
+        SWS2total = 1.d0 / total2SWS
+!       Conversion at pressure zero
+        free2SWS_0p  = 1.d0 + St(i)/Ks_0p + Ft(i)/(Kf_0p)  ! using Kf on free scale
+        total2SWS_0p = total2free_0p * free2SWS_0p         ! KSWS = Ktotal*total2SWS
+
+!       Convert from Total to Seawater scale before pressure correction
+!       Must change to SEAWATER scale: K1, K2, Kb
+        IF (trim(optK1K2) == 'l') THEN
+          K1(i)  = K1(i)*total2SWS_0p
+          K2(i)  = K2(i)*total2SWS_0p
+          !This conversion is unnecessary for the K1,K2 from Millero (2010),
+          !since we use here the formulation already on the seawater scale
+        ENDIF
+        Kb(i)  = Kb(i)*total2SWS_0p
+
+!       Already on SEAWATER scale: K1p, K2p, K3p, Kb, Ksi, Kw
+
+!       Other contants (keep on another scale):
+!          - K0         (independent of pH scale, already pressure corrected)
+!          - Ks         (already on Free scale;   already pressure corrected)
+!          - Kf         (already on Total scale;  already pressure corrected)
+!          - Kspc, Kspa (independent of pH scale; pressure-corrected below)
+
+!       Perform actual pressure correction (on seawater scale)
+        K1(i)   = K1(i)*EXP(lnkpok0(1))
+        K2(i)   = K2(i)*EXP(lnkpok0(2))
+        Kb(i)   = Kb(i)*EXP(lnkpok0(3))
+        Kw(i)   = Kw(i)*EXP(lnkpok0(4))
+        Kspc(i) = Kspc(i)*EXP(lnkpok0(7))
+        Kspa(i) = Kspa(i)*EXP(lnkpok0(8))
+        K1p(i)  = K1p(i)*EXP(lnkpok0(9))
+        K2p(i)  = K2p(i)*EXP(lnkpok0(10))
+        K3p(i)  = K3p(i)*EXP(lnkpok0(11))
+        Ksi(i)  = Ksi(i)*EXP(lnkpok0(12))
+
+!       Convert back to original total scale:
+        K1(i)  = K1(i) *SWS2total
+        K2(i)  = K2(i) *SWS2total
+        K1p(i) = K1p(i)*SWS2total
+        K2p(i) = K2p(i)*SWS2total
+        K3p(i) = K3p(i)*SWS2total
+        Kb(i)  = Kb(i) *SWS2total
+        Ksi(i) = Ksi(i)*SWS2total
+        Kw(i)  = Kw(i) *SWS2total
+
+     ELSE
+
+        K0(i)   = 1.e20_wp
+        K1(i)   = 1.e20_wp
+        K2(i)   = 1.e20_wp
+        Kb(i)   = 1.e20_wp
+        Kw(i)   = 1.e20_wp
+        Ks(i)   = 1.e20_wp
+        Kf(i)   = 1.e20_wp
+        Kspc(i) = 1.e20_wp
+        Kspa(i) = 1.e20_wp
+        K1p(i)  = 1.e20_wp
+        K2p(i)  = 1.e20_wp
+        K3p(i)  = 1.e20_wp
+        Ksi(i)  = 1.e20_wp
+        Bt(i)   = 1.e20_wp
+        Ft(i)   = 1.e20_wp
+        St(i)   = 1.e20_wp
+
+     ENDIF
+
+  END DO
+
+  RETURN
+END SUBROUTINE constants
+
+! ----------------------------------------------------------------------
+!  VARSOLVER
+! ----------------------------------------------------------------------
+!
+!> \file varsolver.f90
+!! \BRIEF 
+!> Module with varsolver subroutine - solve for pH and other carbonate system variables
+!>    Solve for pH and other carbonate system variables (with input from vars routine)
+SUBROUTINE varsolver(ph, pco2, fco2, co2, hco3, co3, OmegaA, OmegaC,             &
+                    temp, salt, ta, tc, pt, sit,                                 &
+                    Bt, St, Ft,                                                  &
+                    K0, K1, K2, Kb, Kw, Ks, Kf, Kspc, Kspa, K1p, K2p, K3p, Ksi,  & 
+                    Patm, Phydro_bar, rhodum, optGAS                             )
+
+  !   Purpose: Solve for pH and other carbonate system variables (with input from vars routine)
+
+  !     INPUT variables:
+  !     ================
+  !     temp    = in situ temperature [degrees C]
+  !     ta      = total alkalinity                     in [eq/m^3] or [eq/kg]   based on optCON in calling routine (vars)
+  !     tc      = dissolved inorganic carbon           in [mol/m^3] or [mol/kg] based on optCON in calling routine (vars)
+  !     pt      = total dissolved inorganic phosphorus in [mol/m^3] or [mol/kg] based on optCON in calling routine (vars)
+  !     sit     = total dissolved inorganic silicon    in [mol/m^3] or [mol/kg] based on optCON in calling routine (vars)
+  !     Bt      = total dissolved inorganic boron      computed in calling routine (vars)
+  !     St      = total dissolved inorganic sulfur     computed in calling routine (vars)
+  !     Ft      = total dissolved inorganic fluorine   computed in calling routine (vars)
+  !     K's     = K0, K1, K2, Kb, Kw, Ks, Kf, Kspc, Kspa, K1p, K2p, K3p, Ksi 
+  !     Patm    = atmospheric pressure [atm]
+  !     Phydro_bar = hydrostatic pressure [bar]
+  !     rhodum  = density factor as computed in calling routine  (vars)
+  !     -----------
+  !     optGAS: choose in situ vs. potential fCO2 and pCO2 (default optGAS = 'Pinsitu')
+  !     ---------
+  !       PRESSURE & T corrections for K0 and the fugacity coefficient (Cf) 
+  !       -> 'Pzero'   = 'zero order' fCO2 and pCO2 (typical approach, which is flawed)
+  !                      considers in situ T & only atm pressure (hydrostatic=0)
+  !       -> 'Ppot'    = 'potential' fCO2 and pCO2 (water parcel brought adiabatically to the surface)
+  !                      considers potential T & only atm pressure (hydrostatic press = 0)
+  !       -> 'Pinsitu' = 'in situ' fCO2 and pCO2 (accounts for huge effects of pressure)
+  !                      considers in situ T & total pressure (atm + hydrostatic)
+  !     ---------
+
+  !     OUTPUT variables:
+  !     =================
+  !     ph   = pH on total scale
+  !     pco2 = CO2 partial pressure (uatm)
+  !     fco2 = CO2 fugacity (uatm)
+  !     co2  = aqueous CO2 concentration in [mol/kg] or [mol/m^3] determined by rhodum (depends on optCON in calling routine)
+  !     hco3 = bicarbonate (HCO3-) concentration in [mol/kg] or [mol/m^3] determined by rhodum
+  !     co3  = carbonate (CO3--) concentration in [mol/kg] or [mol/m^3] determined by rhodum
+  !     OmegaA = Omega for aragonite, i.e., the aragonite saturation state
+  !     OmegaC = Omega for calcite, i.e., the   calcite saturation state
+
+  USE mocsy_singledouble
+  USE mocsy_phsolvers
+
+  IMPLICIT NONE
+
+! Input variables
+  !> <b>in situ temperature</b> [degrees C]
+  REAL(kind=wp), INTENT(in) :: temp
+  !> <b>salinity</b> [on the practical salinity scale, dimensionless]
+  REAL(kind=wp), INTENT(in) :: salt
+  !> total alkalinity in <b>[eq/m^3]</b> OR in <b>[eq/kg]</b>, depending on optCON in calling routine
+  REAL(kind=wp), INTENT(in) :: ta
+  !> dissolved inorganic carbon in <b>[mol/m^3]</b> OR in <b>[mol/kg]</b>, depending on optCON in calling routine
+  REAL(kind=wp), INTENT(in) :: tc
+  !> phosphate concentration in <b>[mol/m^3]</b> OR in <b>[mol/kg]</b>, depending on optCON in calling routine
+  REAL(kind=wp), INTENT(in) :: pt
+  !> total dissolved inorganic silicon concentration in <b>[mol/m^3]</b> OR in <b>[mol/kg]</b>, depending on optCON in calling routine
+  REAL(kind=wp), INTENT(in) :: sit
+  !> total boron from either Uppstrom (1974) or Lee et al. (2010), depending on optB in calling routine
+  REAL(kind=wp), INTENT(in) :: Bt
+  !> total sulfate (Morris & Riley, 1966)
+  REAL(kind=wp), INTENT(in) :: St
+  !> total fluoride  (Riley, 1965)
+  REAL(kind=wp), INTENT(in) :: Ft
+  !> solubility of CO2 in seawater (Weiss, 1974), also known as K0
+  REAL(kind=wp), INTENT(in) :: K0
+  !> K1 for the dissociation of carbonic acid from Lueker et al. (2000) or Millero (2010), depending on optK1K2
+  REAL(kind=wp), INTENT(in) :: K1
+  !> K2 for the dissociation of carbonic acid from Lueker et al. (2000) or Millero (2010), depending on optK1K2
+  REAL(kind=wp), INTENT(in) :: K2
+  !> equilibrium constant for dissociation of boric acid 
+  REAL(kind=wp), INTENT(in) :: Kb
+  !> equilibrium constant for the dissociation of water (Millero, 1995)
+  REAL(kind=wp), INTENT(in) :: Kw
+  !> equilibrium constant for the dissociation of bisulfate (Dickson, 1990)
+  REAL(kind=wp), INTENT(in) :: Ks
+  !> equilibrium constant for the dissociation of hydrogen fluoride 
+  !! from Dickson and Riley (1979) or Perez and Fraga (1987), depending on optKf
+  REAL(kind=wp), INTENT(in) :: Kf
+  !> solubility product for calcite (Mucci, 1983)
+  REAL(kind=wp), INTENT(in) :: Kspc
+  !> solubility product for aragonite (Mucci, 1983)
+  REAL(kind=wp), INTENT(in) :: Kspa
+  !> 1st dissociation constant for phosphoric acid (Millero, 1995)
+  REAL(kind=wp), INTENT(in) :: K1p
+  !> 2nd dissociation constant for phosphoric acid (Millero, 1995)
+  REAL(kind=wp), INTENT(in) :: K2p
+  !> 3rd dissociation constant for phosphoric acid (Millero, 1995)
+  REAL(kind=wp), INTENT(in) :: K3p
+  !> equilibrium constant for the dissociation of silicic acid (Millero, 1995)
+  REAL(kind=wp), INTENT(in) :: Ksi
+  !> total atmospheric pressure <b>[atm]</b>
+  REAL(kind=wp), INTENT(in) :: Patm
+  !> total hydrostatic pressure <b>[bar]</b>
+  REAL(kind=wp), INTENT(in) :: Phydro_bar
+  !> density factor as computed incalling routine  (vars)
+  REAL(kind=wp), INTENT(in) :: rhodum
+  !> for K0,fugacity coefficient choose either \b 'Ppot' (no pressure correction) or \b 'Pinsitu' (with pressure correction) 
+  !! 'Ppot'    - for 'potential' fCO2 and pCO2 (water parcel brought adiabatically to the surface)
+  !! 'Pinsitu' - for 'in situ' values of fCO2 and pCO2, accounting for pressure on K0 and Cf
+  !! with 'Pinsitu' the fCO2 and pCO2 will be many times higher in the deep ocean
+!f2py character*7 optional, intent(in) :: optGAS='Pinsitu'
+  CHARACTER(7), OPTIONAL, INTENT(in) :: optGAS
+
+! Output variables:
+  !> pH on the <b>total scale</b>
+  REAL(kind=wp), INTENT(out) :: ph
+  !> CO2 partial pressure <b>[uatm]</b>
+  REAL(kind=wp), INTENT(out) :: pco2
+  !> CO2 fugacity <b>[uatm]</b>
+  REAL(kind=wp), INTENT(out) :: fco2
+  !> aqueous CO2* concentration, either in <b>[mol/m^3]</b> or <b>[mol/kg</b>] depending on choice for optCON
+  REAL(kind=wp), INTENT(out) :: co2
+  !> bicarbonate ion (HCO3-) concentration, either in <b>[mol/m^3]</b> or <b>[mol/kg]</b> depending on choice for optCON
+  REAL(kind=wp), INTENT(out) :: hco3
+  !> carbonate ion (CO3--) concentration, either in <b>[mol/m^3]</b> or <b>[mol/kg]</b> depending on choice for optCON
+  REAL(kind=wp), INTENT(out) :: co3
+  !> Omega for aragonite, i.e., the aragonite saturation state
+  REAL(kind=wp), INTENT(out) :: OmegaA
+  !> Omega for calcite, i.e., the calcite saturation state
+  REAL(kind=wp), INTENT(out) :: OmegaC
+
+! Local variables
+  REAL(kind=wp) :: Phydro_atm, Ptot
+  REAL(kind=wp) :: Rgas_atm, B, Del, xCO2approx, xc2, fugcoeff
+  REAL(kind=wp) :: tk, tk0
+  real(kind=wp) :: temp68, tempot, tempot68
+  REAL(kind=wp) :: Hinit, H
+  REAL(kind=wp) :: HSO4, HF, HSI, HPO4
+  REAL(kind=wp) :: ab, aw, ac
+  REAL(kind=wp) :: cu, cb, cc
+  REAL(kind=wp) :: Ca
+! Array to pass optional arguments
+  CHARACTER(7) :: opGAS
+
+  IF (PRESENT(optGAS)) THEN
+    opGAS = optGAS
+  ELSE
+    opGAS = 'Pinsitu'
+  ENDIF
+
+! Compute pH from constants and total concentrations
+! - use SolveSAPHE v1.0.1 routines from Munhoven (2013, GMD) modified to use mocsy's Ks instead of its own
+! 1) Compute best starting point for H+ calculation
+  call ahini_for_at(ta, tc, Bt, K1, K2, Kb, Hinit)
+! 2) Solve for H+ using above result as the initial H+ value
+  H = solve_at_general(ta, tc, Bt,                                         & 
+                       pt,     sit,                                        &
+                       St, Ft,                                             &
+                       K0, K1, K2, Kb, Kw, Ks, Kf, K1p, K2p, K3p, Ksi,     &
+                       Hinit)
+! 3) Calculate pH from from H+ concentration (mol/kg)
+  IF (H > 0.d0) THEN
+     pH = -1.*LOG10(H)
+  ELSE
+     pH = 1.e20_wp
+  ENDIF
+
+! Compute carbonate Alk (Ac) by difference: from total Alk and other Alk components
+  HSO4 = St/(1.0d0 + Ks/(H/(1.0d0 + St/Ks)))
+  HF = 1.0d0/(1.0d0 + Kf/H)
+  HSI = 1.0d0/(1.0d0 + H/Ksi)
+  HPO4 = (K1p*K2p*(H + 2.*K3p) - H**3) /                &
+  (H**3 + K1p*H**2 + K1p*K2p*H + K1p*K2p*K3p)
+  ab = Bt/(1.0d0 + H/Kb)
+  aw = Kw/H - H/(1.0d0 + St/Ks)
+  ac = ta + hso4 - sit*hsi - ab - aw + Ft*hf - pt*hpo4
+
+! Calculate CO2*, HCO3-, & CO32- (in mol/kg soln) from Ct, Ac, H+, K1, & K2
+  cu = (2.0d0 * tc - ac) / (2.0d0 + K1 / H)
+  cb = K1 * cu / H
+  cc = K2 * cb / H
+
+! When optCON = 'mol/m3' in calling routine (vars), then:
+! convert output var concentrations from mol/kg to mol/m^3
+! e.g., for case when drho = 1028, multiply by [1.028 kg/L  x  1000 L/m^3])
+  co2  = cu * rhodum
+  hco3 = cb * rhodum
+  co3  = cc * rhodum
+
+! Determine CO2 fugacity [uatm]
+! NOTE: equation just below requires CO2* in mol/kg
+  fCO2 = cu * 1.e6_wp/K0
+
+! Determine CO2 partial pressure from CO2 fugacity [uatm]
+  tk = 273.15d0 + temp
+  !Compute EITHER "potential pCO2" OR "in situ pCO2" (T and P used for calculations will differ)
+  IF     (trim(opGAS) == 'Pzero'   .OR. trim(opGAS) == 'pzero') THEN
+     tk0 = tk                 !in situ temperature (K) for K0 calculation
+     Ptot = Patm              !total pressure (in atm) = atmospheric pressure ONLY
+  ELSEIF (trim(opGAS) == 'Ppot' .OR. trim(opGAS) == 'ppot') THEN
+     !Use potential temperature and atmospheric pressure (water parcel adiabatically brought back to surface)
+     !temp68 = (temp - 0.0002d0) / 0.99975d0          !temp = in situ T; temp68 is same converted to ITPS-68 scale
+     !tempot68 = sw_ptmp(salt, temp68, Phydro_bar*10d0, 0.0d0) !potential temperature (C)
+     !tempot   = 0.99975*tempot68 + 0.0002
+     !tk0 = tempot + 273.15d0  !potential temperature (K) for fugacity coeff. calc as needed for potential fCO2 & pCO2
+     tempot = sw_ptmp(salt, temp, Phydro_bar*10._wp, 0.0_wp) !potential temperature (C)
+     tk0 = tempot + 273.15d0  !potential temperature (K) for fugacity coeff. calc as needed for potential fCO2 & pCO2
+     Ptot = Patm              !total pressure (in atm) = atmospheric pressure ONLY
+  ELSEIF (trim(opGAS) == 'Pinsitu' .OR. trim(opGAS) == 'pinsitu') THEN
+     !Use in situ temperature and total pressure 
+     tk0 = tk                             !in situ temperature (K) for fugacity coefficient calculation
+     Phydro_atm = Phydro_bar / 1.01325d0  !convert hydrostatic pressure from bar to atm (1.01325 bar / atm)
+     Ptot = Patm + Phydro_atm            !total pressure (in atm) = atmospheric pressure + hydrostatic pressure
+  ELSE
+     PRINT *, "optGAS must be 'Pzero', 'Ppot', or 'Pinsitu'"
+     STOP
+  ENDIF
+
+! Now that we have T and P in the right form, continue with calculation of fugacity coefficient (and pCO2)
+  Rgas_atm = 82.05736_wp      ! (cm3 * atm) / (mol * K)  CODATA (2006)
+! To compute fugcoeff, we need 3 other terms (B, Del, xc2) in addition to 3 others above (tk, Ptot, Rgas_atm)
+  B = -1636.75d0 + 12.0408d0*tk0 - 0.0327957d0*(tk0*tk0) + 0.0000316528d0*(tk0*tk0*tk0)
+  Del = 57.7d0 - 0.118d0*tk0
+! "x2" term often neglected (assumed = 1) in applications of Weiss's (1974) equation 9
+! x2 = 1 - x1 = 1 - xCO2 (it is very close to 1, but not quite)
+! Let's assume that xCO2 = fCO2. Resulting fugcoeff is identical to 8th digit after the decimal.
+  xCO2approx = fCO2 * 1.e-6_wp
+  IF (trim(opGAS) == 'Pinsitu' .OR. trim(opGAS) == 'pinsitu') THEN
+!    xCO2approx = 400.0e-6_wp      !a simple test (gives about same result as seacarb for pCO2insitu)
+!    approximate surface xCO2 ~ surface fCO2 (i.e., in situ fCO2 d by exponential pressure correction)
+     xCO2approx = xCO2approx * exp( ((1-Ptot)*32.3_wp)/(82.05736_wp*tk0) )   ! of K0 press. correction, see Weiss (1974, equation 5)
+  ENDIF
+  xc2 = (1.0d0 - xCO2approx)**2 
+  fugcoeff = exp( Ptot*(B + 2.0d0*xc2*Del)/(Rgas_atm*tk0) )
+  pCO2 = fCO2 / fugcoeff
+
+! Determine Omega Calcite et Aragonite
+! OmegaA = ((0.01028d0*salt/35.0d0)*cc) / Kspa
+! OmegaC = ((0.01028d0*salt/35.0d0)*cc) / Kspc
+! - see comments from Munhoven on the best value "0.02128" which differs slightly from the best practices guide (0.02127)
+  Ca = (0.02128d0/40.078d0) * salt/1.80655d0
+  OmegaA = (Ca*cc) / Kspa
+  OmegaC = (Ca*cc) / Kspc
+
+  RETURN
+END SUBROUTINE varsolver
+
+! ----------------------------------------------------------------------
+!  VARS
+! ----------------------------------------------------------------------
+!
+!> \file vars.f90
+!! \BRIEF 
+!> Module with vars subroutine - compute carbonate system vars from DIC,Alk,T,S,P,nuts
+!>    Computes standard carbonate system variables (pH, CO2*, HCO3- and CO32-, OmegaA, OmegaC, R)
+!!    as 1D arrays FROM
+!!    temperature, salinity, pressure,
+!!    total alkalinity (ALK), dissolved inorganic carbon (DIC),
+!!    silica and phosphate concentrations (all 1-D arrays)
+SUBROUTINE vars(ph, pco2, fco2, co2, hco3, co3, OmegaA, OmegaC, BetaD, rhoSW, p, tempis,  &
+                temp, sal, alk, dic, sil, phos, Patm, depth, lat, N,                      &
+                optCON, optT, optP, optB, optK1K2, optKf, optGAS                          )
+
+  !   Purpose:
+  !     Computes other standard carbonate system variables (pH, CO2*, HCO3- and CO32-, OmegaA, OmegaC, R)
+  !     as 1D arrays
+  !     FROM:
+  !     temperature, salinity, pressure,
+  !     total alkalinity (ALK), dissolved inorganic carbon (DIC),
+  !     silica and phosphate concentrations (all 1-D arrays)
+
+  !     INPUT variables:
+  !     ================
+  !     Patm    = atmospheric pressure [atm]
+  !     depth   = depth [m]     (with optP='m', i.e., for a z-coordinate model vertical grid is depth, not pressure)
+  !             = pressure [db] (with optP='db')
+  !     lat     = latitude [degrees] (needed to convert depth to pressure, i.e., when optP='m')
+  !             = dummy array (unused when optP='db')
+  !     temp    = potential temperature [degrees C] (with optT='Tpot', i.e., models carry tempot, not in situ temp)
+  !             = in situ   temperature [degrees C] (with optT='Tinsitu', e.g., for data)
+  !     sal     = salinity in [psu]
+  !     alk     = total alkalinity in [eq/m^3] with optCON = 'mol/m3'
+  !             =               [eq/kg]  with optCON = 'mol/kg'
+  !     dic     = dissolved inorganic carbon [mol/m^3] with optCON = 'mol/m3'
+  !             =                            [mol/kg]  with optCON = 'mol/kg'
+  !     sil     = silica    [mol/m^3] with optCON = 'mol/m3'
+  !             =           [mol/kg]  with optCON = 'mol/kg'
+  !     phos    = phosphate [mol/m^3] with optCON = 'mol/m3'
+  !             =           [mol/kg]  with optCON = 'mol/kg'
+  !     INPUT options:
+  !     ==============
+  !     -----------
+  !     optCON: choose input & output concentration units - mol/kg (data) vs. mol/m^3 (models)
+  !     -----------
+  !       -> 'mol/kg' for DIC, ALK, sil, & phos given on mokal scale, i.e., in mol/kg  (std DATA units)
+  !       -> 'mol/m3' for DIC, ALK, sil, & phos given in mol/m^3 (std MODEL units)
+  !     -----------
+  !     optT: choose in situ vs. potential temperature as input
+  !     ---------
+  !     NOTE: Carbonate chem calculations require IN-SITU temperature (not potential Temperature)
+  !       -> 'Tpot' means input is pot. Temperature (in situ Temp "tempis" is computed)
+  !       -> 'Tinsitu' means input is already in-situ Temperature, not pot. Temp ("tempis" not computed)
+  !     ---------
+  !     optP: choose depth (m) vs pressure (db) as input
+  !     ---------
+  !       -> 'm'  means "depth" input is in "m" (thus in situ Pressure "p" [db] is computed)
+  !       -> 'db' means "depth" input is already in situ pressure [db], not m (thus p = depth)
+  !     ---------
+  !     optB: choose total boron formulation - Uppström (1974) vs. Lee et al. (2010)
+  !     ---------
+  !       -> 'u74' means use classic formulation of Uppström (1974) for total Boron
+  !       -> 'l10' means use newer   formulation of Lee et al. (2010) for total Boron
+  !     ---------
+  !     optK1K2:
+  !     ---------
+  !       -> 'l'   means use Lueker et al. (2000) formulations for K1 & K2 (recommended by Dickson et al. 2007)
+  !                **** BUT this should only be used when 2 < T < 35 and 19 < S < 43
+  !       -> 'm10' means use Millero (2010) formulation for K1 & K2 (see Dickson et al., 2007)
+  !                **** Valid for 0 < T < 50°C and 1 < S < 50 psu
+  !     ----------
+  !     optKf:
+  !     ----------
+  !       -> 'pf' means use Perez & Fraga (1987) formulation for Kf (recommended by Dickson et al., 2007)
+  !               **** BUT Valid for  9 < T < 33°C and 10 < S < 40.
+  !       -> 'dg' means use Dickson & Riley (1979) formulation for Kf (recommended by Dickson & Goyet, 1994)
+  !     -----------
+  !     optGAS: choose in situ vs. potential fCO2 and pCO2
+  !     ---------
+  !       PRESSURE corrections for K0 and the fugacity coefficient (Cf) 
+  !       -> 'Pzero'   = 'zero order' fCO2 and pCO2 (typical approach, which is flawed)
+  !                      considers in situ T & only atm pressure (hydrostatic=0)
+  !       -> 'Ppot'    = 'potential' fCO2 and pCO2 (water parcel brought adiabatically to the surface)
+  !                      considers potential T & only atm pressure (hydrostatic press = 0)
+  !       -> 'Pinsitu' = 'in situ' fCO2 and pCO2 (accounts for huge effects of pressure)
+  !                      considers in situ T & total pressure (atm + hydrostatic)
+  !     ---------
+
+  !     OUTPUT variables:
+  !     =================
+  !     ph   = pH on total scale
+  !     pco2 = CO2 partial pressure (uatm)
+  !     fco2 = CO2 fugacity (uatm)
+  !     co2  = aqueous CO2 concentration in [mol/kg] or [mol/m^3] depending on optCON
+  !     hco3 = bicarbonate (HCO3-) concentration in [mol/kg] or [mol/m^3] depending on optCON
+  !     co3  = carbonate (CO3--) concentration in [mol/kg] or [mol/m^3] depending on optCON
+  !     OmegaA = Omega for aragonite, i.e., the aragonite saturation state
+  !     OmegaC = Omega for calcite, i.e., the   calcite saturation state
+  !     BetaD = Revelle factor   dpCO2/pCO2 / dDIC/DIC
+  !     rhoSW  = in-situ density of seawater; rhoSW = f(s, t, p)
+  !     p = pressure [decibars]; p = f(depth, latitude) if computed from depth [m] OR p = depth if [db]
+  !     tempis  = in-situ temperature [degrees C]
+
+  USE mocsy_singledouble
+
+  IMPLICIT NONE
+
+! Input variables
+  !>     number of records
+  INTEGER, INTENT(in) :: N
+  !> either <b>in situ temperature</b> (when optT='Tinsitu', typical data) 
+  !! OR <b>potential temperature</b> (when optT='Tpot', typical models) <b>[degree C]</b>
+  REAL(kind=wp), INTENT(in),    DIMENSION(N) :: temp
+  !> salinity <b>[psu]</b>
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: sal
+  !> total alkalinity in <b>[eq/m^3]</b> (when optCON = 'mol/m3') OR in <b>[eq/kg]</b>  (when optCON = 'mol/kg')
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: alk
+  !> dissolved inorganic carbon in <b>[mol/m^3]</b> (when optCON = 'mol/m3') OR in <b>[mol/kg]</b> (when optCON = 'mol/kg')
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: dic
+  !> SiO2 concentration in <b>[mol/m^3]</b> (when optCON = 'mol/m3') OR in <b>[mol/kg]</b> (when optCON = 'mol/kg')
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: sil
+  !> phosphate concentration in <b>[mol/m^3]</b> (when optCON = 'mol/m3') OR in <b>[mol/kg]</b> (when optCON = 'mol/kg')
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: phos
+!f2py optional , depend(sal) :: n=len(sal)
+  !> atmospheric pressure <b>[atm]</b>
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: Patm
+  !> depth in \b meters (when optP='m') or \b decibars (when optP='db')
+  REAL(kind=wp), INTENT(in),    DIMENSION(N) :: depth
+  !> latitude <b>[degrees north]</b>
+  REAL(kind=wp), INTENT(in),    DIMENSION(N) :: lat
+
+  !> choose either \b 'mol/kg' (std DATA units) or \b 'mol/m3' (std MODEL units) to select 
+  !! concentration units for input (for alk, dic, sil, phos) & output (co2, hco3, co3)
+  CHARACTER(6), INTENT(in) :: optCON
+  !> choose \b 'Tinsitu' for in situ temperature or \b 'Tpot' for potential temperature (in situ Temp is computed, needed for models)
+  CHARACTER(7), INTENT(in) :: optT
+  !> for depth input, choose \b "db" for decibars (in situ pressure) or \b "m" for meters (pressure is computed, needed for models)
+  CHARACTER(2), INTENT(in) :: optP
+  !> for total boron, choose either \b 'u74' (Uppstrom, 1974) or \b 'l10' (Lee et al., 2010).
+  !! The 'l10' formulation is based on 139 measurements (instead of 20), 
+  !! uses a more accurate method, and
+  !! generally increases total boron in seawater by 4% 
+!f2py character*3 optional, intent(in) :: optB='l10'
+  CHARACTER(3), OPTIONAL, INTENT(in) :: optB
+  !> for Kf, choose either \b 'pf' (Perez & Fraga, 1987) or \b 'dg' (Dickson & Riley, 1979)
+!f2py character*2 optional, intent(in) :: optKf='pf'
+  CHARACTER(2), OPTIONAL, INTENT(in) :: optKf
+  !> for K1,K2 choose either \b 'l' (Lueker et al., 2000) or \b 'm10' (Millero, 2010) 
+!f2py character*3 optional, intent(in) :: optK1K2='l'
+  CHARACTER(3), OPTIONAL, INTENT(in) :: optK1K2
+  !> for K0,fugacity coefficient choose either \b 'Ppot' (no pressure correction) or \b 'Pinsitu' (with pressure correction) 
+  !! 'Ppot'    - for 'potential' fCO2 and pCO2 (water parcel brought adiabatically to the surface)
+  !! 'Pinsitu' - for 'in situ' values of fCO2 and pCO2, accounting for pressure on K0 and Cf
+  !! with 'Pinsitu' the fCO2 and pCO2 will be many times higher in the deep ocean
+!f2py character*7 optional, intent(in) :: optGAS='Pinsitu'
+  CHARACTER(7), OPTIONAL, INTENT(in) :: optGAS
+
+! Output variables:
+  !> pH on the <b>total scale</b>
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: ph
+  !> CO2 partial pressure <b>[uatm]</b>
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: pco2
+  !> CO2 fugacity <b>[uatm]</b>
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: fco2
+  !> aqueous CO2* concentration, either in <b>[mol/m^3]</b> or <b>[mol/kg</b>] depending on choice for optCON
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: co2
+  !> bicarbonate ion (HCO3-) concentration, either in <b>[mol/m^3]</b> or <b>[mol/kg]</b> depending on choice for optCON
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: hco3
+  !> carbonate ion (CO3--) concentration, either in <b>[mol/m^3]</b> or <b>[mol/kg]</b> depending on choice for optCON
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: co3
+  !> Omega for aragonite, i.e., the aragonite saturation state
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: OmegaA
+  !> Omega for calcite, i.e., the calcite saturation state
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: OmegaC
+  !> Revelle factor, i.e., dpCO2/pCO2 / dDIC/DIC
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: BetaD
+  !> in-situ density of seawater; rhoSW = f(s, t, p) in <b>[kg/m3]</b>
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: rhoSW
+  !> pressure <b>[decibars]</b>; p = f(depth, latitude) if computed from depth [m] (when optP='m') OR p = depth [db] (when optP='db')
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: p
+  !> in-situ temperature \b <b>[degrees C]</b>
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: tempis
+
+! Local variables
+  REAL(kind=wp) :: ssal, salk, sdic, ssil, sphos
+  REAL(kind=wp) :: tempot, tempis68, tempot68
+  REAL(kind=wp) :: drho
+
+  REAL(kind=wp) :: K0, K1, K2, Kb, Kw, Ks, Kf, Kspc
+  REAL(kind=wp) :: Kspa, K1p, K2p, K3p, Ksi
+  REAL(kind=wp) :: St, Ft, Bt
+
+  REAL(kind=wp), DIMENSION(1) :: aK0, aK1, aK2, aKb, aKw, aKs, aKf, aKspc
+  REAL(kind=wp), DIMENSION(1) :: aKspa, aK1p, aK2p, aK3p, aKsi
+  REAL(kind=wp), DIMENSION(1) :: aSt, aFt, aBt
+
+  REAL(kind=wp) :: Patmd, Ptot, Rgas_atm, B, Del, xCO2approx, xc2, fugcoeff
+  REAL(kind=wp) :: Phydro_atm
+
+  INTEGER :: i, icount
+
+  REAL(kind=wp) :: t, tk, prb
+  REAL(kind=wp) :: s
+  REAL(kind=wp) :: tc, ta
+  REAL(kind=wp) :: sit, pt
+  REAL(kind=wp) :: Hinit
+  REAL(kind=wp) :: ah1
+
+  REAL(kind=wp) :: HSO4, HF, HSI, HPO4
+  REAL(kind=wp) :: ab, aw, ac, ah2, erel
+
+  REAL(kind=wp) :: cu, cb, cc
+
+  REAL(kind=wp), DIMENSION(2) :: dicdel, pco2del
+  REAL(kind=wp) :: dx, Rf
+  REAL(kind=wp) :: dph, dpco2, dfco2, dco2, dhco3, dco3, dOmegaA, dOmegaC
+
+  INTEGER :: kcomp
+  INTEGER :: j, minusplus
+
+! Arrays to pass optional arguments into or use defaults (Dickson et al., 2007)
+  CHARACTER(3) :: opB
+  CHARACTER(2) :: opKf
+  CHARACTER(3) :: opK1K2
+  CHARACTER(7) :: opGAS
+
+! Set defaults for optional arguments (in Fortran 90)
+! Note:  Optional arguments with f2py (python) are set above with 
+!        the !f2py statements that precede each type declaraion
+  IF (PRESENT(optB)) THEN
+!   print *,"optB present:"
+!   print *,"optB = ", optB 
+    opB = optB
+  ELSE
+!   Default is Lee et al (2010) for total boron
+!   print *,"optB NOT present:"
+    opB = 'l10'
+!   print *,"opB = ", opB 
+  ENDIF
+  IF (PRESENT(optKf)) THEN
+!   print *,"optKf = ", optKf
+    opKf = optKf
+  ELSE
+!   print *,"optKf NOT present:"
+!   Default is Perez & Fraga (1987) for Kf
+    opKf = 'pf'
+!   print *,"opKf = ", opKf
+  ENDIF
+  IF (PRESENT(optK1K2)) THEN
+!   print *,"optK1K2 = ", optK1K2
+    opK1K2 = optK1K2
+  ELSE
+!   print *,"optK1K2 NOT present:"
+!   Default is Lueker et al. 2000) for K1 & K2
+    opK1K2 = 'l'
+!   print *,"opK1K2 = ", opK1K2
+  ENDIF
+  IF (PRESENT(optGAS)) THEN
+    opGAS = optGAS
+  ELSE
+    opGAS = 'Pinsitu'
+  ENDIF
+
+  icount = 0
+  DO i = 1, N
+     icount = icount + 1
+!    ===============================================================
+!    Convert model depth -> press; convert model Theta -> T in situ
+!    ===============================================================
+!    * Model temperature tracer is usually "potential temperature"
+!    * Model vertical grid is usually in meters
+!    BUT carbonate chem routines require pressure & in-situ T
+!    Thus before computing chemistry, if appropriate,
+!    convert these 2 model vars (input to this routine)
+!    - depth [m] => convert to pressure [db]
+!    - potential temperature (C) => convert to in-situ T (C)
+!    -------------------------------------------------------
+!    1)  Compute pressure [db] from depth [m] and latitude [degrees] (if input is m, for models)
+     !print *,"optP =", optP, "end"
+     IF (trim(optP) == 'm' ) THEN
+!       Compute pressure [db] from depth [m] and latitude [degrees]
+        p(i) = p80(depth(i), lat(i))
+     ELSEIF (trim(optP) == 'db') THEN
+!       In this case (where optP = 'db'), p is input & output (no depth->pressure conversion needed)
+        p(i) = depth(i)
+     ELSE
+        !print *,"optP =", optP, "end"
+        PRINT *,"optP must be either 'm' or 'db'"
+        STOP
+     ENDIF
+
+!    2) Convert potential T to in-situ T (if input is Tpot, i.e. case for models):
+     IF (trim(optT) == 'Tpot' .OR. trim(optT) == 'tpot') THEN
+        tempot = temp(i)
+!       This is the case for most models and some data
+!       a) Convert the pot. temp on today's "ITS 90" scale to older IPTS 68 scale
+!          (see Dickson et al., Best Practices Guide, 2007, Chap. 5, p. 7, including footnote)
+        tempot68 = (tempot - 0.0002) / 0.99975
+!       b) Compute "in-situ Temperature" from "Potential Temperature" (both on IPTS 68)
+        tempis68 = sw_temp(sal(i), tempot68, p(i), 0.0_wp )
+!       c) Convert the in-situ temp on older IPTS 68 scale to modern scale (ITS 90)
+        tempis(i) = 0.99975*tempis68 + 0.0002
+!       Note: parts (a) and (c) above are tiny corrections;
+!             part  (b) is a big correction for deep waters (but zero at surface)
+     ELSEIF (trim(optT) == 'Tinsitu' .OR. trim(optT) == 'tinsitu') THEN
+!       When optT = 'Tinsitu', tempis is input & output (no tempot needed)
+        tempis(i) = temp(i)
+        tempis68  = (temp(i) - 0.0002) / 0.99975
+!       dtempot68 = sw_ptmp(DBLE(sal(i)), DBLE(tempis68), DBLE(p), 0.0d0)
+!       dtempot   = 0.99975*dtempot68 + 0.0002
+     ELSE
+        PRINT *,"optT must be either 'Tpot' or 'Tinsitu'"
+        PRINT *,"you specified optT =", trim(optT) 
+        STOP
+     ENDIF
+
+!    ================================================================
+!    Carbonate chemistry computations
+!    ================================================================
+     IF (dic(i) > 0. .AND. dic(i) < 1.0e+4) THEN
+!       Test to indicate if any of input variables are unreasonable
+        IF (       sal(i) < 0.   &
+             .OR.  alk(i) < 0.   &
+             .OR.  dic(i) < 0.   &
+             .OR.  sil(i) < 0.   &
+             .OR. phos(i) < 0.   &
+             .OR.  sal(i) > 1e+3 &
+             .OR.  alk(i) > 1e+3 &
+             .OR.  dic(i) > 1e+3 &
+             .OR.  sil(i) > 1e+3 &
+             .OR. phos(i) > 1e+3) THEN
+           PRINT *, 'i, icount, tempot, sal,    alk,    dic,    sil,    phos =', &
+                     i, icount, tempot, sal(i), alk(i), dic(i), sil(i), phos(i)
+        ENDIF
+!       Zero out any negative salinity, phosphate, silica, dic, and alk
+        IF (sal(i) < 0.0) THEN
+           ssal = 0.0
+        ELSE
+           ssal = sal(i)
+        ENDIF
+        IF (phos(i) < 0.0) THEN
+           sphos = 0.0
+        ELSE
+           sphos = phos(i)
+        ENDIF
+        IF (sil(i) < 0.0) THEN
+           ssil = 0.0
+        ELSE
+           ssil = sil(i)
+        ENDIF
+        IF (dic(i) < 0.0) THEN
+          sdic = 0.0
+        ELSE
+          sdic = dic(i)
+        ENDIF
+        IF (alk(i) < 0.0) THEN
+          salk = 0.0
+        ELSE
+          salk = alk(i)
+        ENDIF
+
+!       Absolute temperature (Kelvin) & related variables
+        t  = DBLE(tempis(i))
+        tk = 273.15d0 + t
+
+!       Atmospheric pressure
+        Patmd = DBLE(Patm(i))
+!       Hydrostatic pressure (prb is in bars)
+        prb = DBLE(p(i)) / 10.0d0
+        Phydro_atm = prb / 1.01325d0  ! convert hydrostatic pressure from bar to atm (1.01325 bar / atm)
+!       Total pressure [atm]
+        IF     (trim(opGAS) == 'Pzero'     .OR. trim(opGAS) == 'pzero') THEN
+           Ptot = Patmd               ! total pressure (in atm) = atmospheric pressure ONLY
+        ELSEIF (trim(opGAS) == 'Ppot'    .OR. trim(opGAS) == 'ppot') THEN
+           Ptot = Patmd               ! total pressure (in atm) = atmospheric pressure ONLY
+        ELSEIF (trim(opGAS) == 'Pinsitu' .OR. trim(opGAS) == 'pinsitu') THEN
+           Ptot = Patmd + Phydro_atm   ! total pressure (in atm) = atmospheric pressure + hydrostatic pressure
+        ELSE
+           PRINT *, "optGAS must be 'Pzero', 'Ppot', or 'Pinsitu'"
+           STOP
+        ENDIF
+
+!       Salinity (equivalent array in double precision)
+        s = DBLE(ssal)
+
+!       Get all equilibrium constants and total concentrations of SO4, F, B
+        CALL constants(aK0, aK1, aK2, aKb, aKw, aKs, aKf, aKspc, aKspa,  &
+                       aK1p, aK2p, aK3p, aKsi,                           &
+                       aSt, aFt, aBt,                                    &
+                       temp(i), sal(i), Patm(i),                         &
+                       depth(i), lat(i), 1,                              &
+                       optT, optP, opB, opK1K2, opKf, opGAS              )
+
+!       Unlike f77, in F90 we can't assign an array (dimen=1) to a scalar in a routine argument
+!       Thus, set scalar constants equal to array (dimension=1) values required as arguments
+        K0 = aK0(1) ; K1 = aK1(1) ; K2 = aK2(1) ; Kb = aKb(1) ; Kw = aKw(1) 
+        Ks = aKs(1) ; Kf = aKs(1) ; Kspc = aKspc(1) ; Kspa = aKspa(1) 
+        K1p = aK1p(1) ; K2p = aK2p(1) ; K3p = aK3p(1) ; Ksi = aKsi(1)
+        St = aSt(1) ; Ft = aFt(1) ; Bt = aBt(1)
+
+!       Compute in-situ density [kg/m^3]
+        rhoSW(i) =  rho(ssal, tempis68, prb)
+
+!       Either convert units of DIC and ALK (MODEL case) or not (DATA case)
+        IF     (trim(optCON) == 'mol/kg') THEN
+!          No conversion:
+!          print *,'DIC and ALK already given in mol/kg (std DATA units)'
+           drho = 1.
+        ELSEIF (trim(optCON) == 'mol/m3') THEN
+!          Do conversion:
+!          print *,"DIC and ALK given in mol/m^3 (std MODEL units)"
+           drho = DBLE(rhoSW(i))
+        ELSE
+           PRINT *,"optCON must be either 'mol/kg' or 'mol/m3'"
+           STOP
+        ENDIF
+
+        tc  = DBLE(sdic)/drho
+        ta  = DBLE(salk)/drho
+        sit = DBLE(ssil)/drho
+        pt  = DBLE(sphos)/drho
+
+!       Solve for pH and all other variables
+!       ------------------------------------
+        CALL varsolver(dph, dpco2, dfco2, dco2, dhco3, dco3, dOmegaA, dOmegaC,     &
+                      t, s, ta, tc, pt, sit,                                       &
+                      Bt, St, Ft,                                                  &
+                      K0, K1, K2, Kb, Kw, Ks, Kf, Kspc, Kspa, K1p, K2p, K3p, Ksi,  & 
+                      Patmd, prb, drho, opGAS                                     )
+
+!       Convert all output variables from double to single precision
+        pH(i)     = REAL(dph)
+        co2(i)    = REAL(dco2)
+        hco3(i)   = REAL(dhco3)
+        co3(i)    = REAL(dco3)
+        fCO2(i)   = REAL(dfCO2)
+        pCO2(i)   = REAL(dpCO2)
+        OmegaA(i) = REAL(dOmegaA)
+        OmegaC(i) = REAL(dOmegaC)
+
+!       Compute Revelle factor numerically (derivative using centered-difference scheme)
+        DO j=1,2
+           minusplus = (-1)**j
+           dx = 0.1 * 1e-6         ! Numerical tests found for DIC that optimal dx = 0.1 umol/kg (0.1e-6 mol/kg)
+           dicdel(j) = tc + DBLE(minusplus)*dx/2.0d0
+            CALL varsolver(dph, dpco2, dfco2, dco2, dhco3, dco3, dOmegaA, dOmegaC, &
+               t, s, ta, dicdel(j), pt, sit,                                       &
+               Bt, St, Ft,                                                         &
+               K0, K1, K2, Kb, Kw, Ks, Kf, Kspc, Kspa, K1p, K2p, K3p, Ksi,         & 
+               Patmd, prb, drho, optGAS                                            )
+            pco2del(j) = dpco2
+        END DO
+       !Classic finite centered difference formula for derivative (2nd order accurate)
+        Rf = (pco2del(2) - pco2del(1)) / (dicdel(2) - dicdel(1))       ! dpCO2/dDIC
+       !Rf = (pco2del(2) - pco2del(1)) / (dx)                          ! dpCO2/dDIC (same as just above)
+        Rf = Rf * tc / dpco2                                           ! R = (dpCO2/dDIC) * (DIC/pCO2)
+
+        BetaD(i) = REAL(Rf)
+
+     ELSE
+
+        ph(i)     = 1.e20_wp
+        pco2(i)   = 1.e20_wp
+        fco2(i)   = 1.e20_wp
+        co2(i)    = 1.e20_wp
+        hco3(i)   = 1.e20_wp
+        co3(i)    = 1.e20_wp
+        OmegaA(i) = 1.e20_wp
+        OmegaC(i) = 1.e20_wp
+        BetaD(i)  = 1.e20_wp
+        rhoSW(i)  = 1.e20_wp
+        p(i)      = 1.e20_wp
+        tempis(i) = 1.e20_wp
+
+     ENDIF
+
+  END DO
+
+  RETURN
+END SUBROUTINE vars
+
+! ----------------------------------------------------------------------
+!  P2FCO2
+! ----------------------------------------------------------------------
+!
+!> \file p2fCO2.f90
+!! \BRIEF 
+!>    Module with p2fCO2 subroutine - compute fCO2 from pCO2, in situ T, atm pressure, hydrostatic pressure
+!>    Compute fCO2 from arrays of pCO2, in situ temp, atm pressure, & hydrostatic pressure
+SUBROUTINE p2fCO2(pCO2, temp, Patm, p, N, fCO2)
+  !    Purpose:
+  !    Compute fCO2 from arrays of pCO2, in situ temp, atm pressure, & hydrostatic pressure
+
+  USE mocsy_singledouble
+  IMPLICIT NONE
+
+  !> number of records
+  INTEGER, INTENT(in) :: N
+
+! INPUT variables
+  !> oceanic partial pressure of CO2 [uatm]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: pCO2
+  !> in situ temperature [C]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: temp
+  !> atmospheric pressure [atm]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: Patm
+  !> hydrostatic pressure [db]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: p
+
+! OUTPUT variables:
+  !> fugacity of CO2 [uatm] 
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: fCO2
+
+! LOCAL variables:
+  REAL(kind=wp) :: dpCO2, dtemp, tk, dPatm, prb
+  REAL(kind=wp) :: Ptot, Rgas_atm, B, Del, xCO2approx, xc2, fugcoeff
+  REAL(kind=wp) :: dfCO2
+
+  INTEGER :: i
+
+! REAL(kind=wp) :: sw_ptmp
+! EXTERNAL sw_ptmp
+
+  DO i = 1,N
+     dpCO2     = DBLE(pCO2(i))
+     dtemp     = DBLE(temp(i))
+     dPatm     = DBLE(Patm(i))
+     tk = 273.15d0 + DBLE(temp(i))     !Absolute temperature (Kelvin)
+     prb = DBLE(p(i)) / 10.0d0         !Pressure effect (prb is in bars)
+     Ptot = dPatm + prb/1.01325d0      !Total pressure (atmospheric + hydrostatic) [atm]
+     Rgas_atm = 82.05736_wp            !R in (cm3 * atm) / (mol * K)  from CODATA (2006)
+!    To compute fugcoeff, we need 3 other terms (B, Del, xc2) as well as 3 others above (tk, Ptot, Rgas_atm)
+     B = -1636.75d0 + 12.0408d0*tk - 0.0327957d0*(tk*tk) + 0.0000316528d0*(tk*tk*tk)
+     Del = 57.7d0 - 0.118d0*tk
+!    "x2" term often neglected (assumed = 1) in applications of Weiss's (1974) equation 9
+!    x2 = 1 - x1 = 1 - xCO2 (it is very close to 1, but not quite)
+!    Let's assume that xCO2 = pCO2. Resulting fugcoeff is identical to 8th digit after the decimal.
+     xCO2approx = dpCO2 * 1.e-6_wp
+     xc2 = (1.0d0 - xCO2approx)**2 
+     fugcoeff = EXP( Ptot*(B + 2.0d0*xc2*Del)/(Rgas_atm*tk) )
+     dfCO2 = dpCO2 * fugcoeff
+     fCO2(i) = REAL(dfCO2)
+  END DO
+
+  RETURN
+END SUBROUTINE p2fCO2
+
+! ----------------------------------------------------------------------
+!  P2FCO2
+! ----------------------------------------------------------------------
+!
+!> \file f2pCO2.f90
+!! \BRIEF 
+!>    Module with f2pCO2 subroutine - compute pCO2 from fCO2, in situ T, atm pressure, hydrostatic pressure
+!>    Compute pCO2 from arrays of fCO2, in situ temp, atm pressure, & hydrostatic pressure
+SUBROUTINE f2pCO2(fCO2, temp, Patm, p, N, pCO2)
+  !    Purpose:
+  !    Compute pCO2 from arrays of fCO2, in situ temp, atm pressure, & hydrostatic pressure
+
+  USE mocsy_singledouble
+  IMPLICIT NONE
+
+  !> number of records
+  INTEGER, intent(in) :: N
+
+! INPUT variables
+  !> oceanic fugacity of CO2 [uatm]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: fCO2
+  !> in situ temperature [C]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: temp
+  !> atmospheric pressure [atm]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: Patm
+  !> hydrostatic pressure [db]
+  REAL(kind=wp), INTENT(in), DIMENSION(N) :: p
+
+! OUTPUT variables:
+  !> oceanic partial pressure of CO2 [uatm] 
+  REAL(kind=wp), INTENT(out), DIMENSION(N) :: pCO2
+
+! LOCAL variables:
+  REAL(kind=wp) :: dfCO2, dtemp, tk, dPatm, prb
+  REAL(kind=wp) :: Ptot, Rgas_atm, B, Del, xCO2approx, xc2, fugcoeff
+  REAL(kind=wp) :: dpCO2
+
+  INTEGER :: i
+
+! REAL(kind=wp) :: sw_ptmp
+! EXTERNAL sw_ptmp
+
+  DO i = 1,N
+     dfCO2     = DBLE(fCO2(i))
+     dtemp     = DBLE(temp(i))
+     dPatm     = DBLE(Patm(i))
+     tk = 273.15d0 + DBLE(temp(i))     !Absolute temperature (Kelvin)
+     prb = DBLE(p(i)) / 10.0d0         !Pressure effect (prb is in bars)
+     Ptot = dPatm + prb/1.01325d0      !Total pressure (atmospheric + hydrostatic) [atm]
+     Rgas_atm = 82.05736_wp            !R in (cm3 * atm) / (mol * K)  from CODATA (2006)
+!    To compute fugcoeff, we need 3 other terms (B, Del, xc2) as well as 3 others above (tk, Ptot, Rgas_atm)
+     B = -1636.75d0 + 12.0408d0*tk - 0.0327957d0*(tk*tk) + 0.0000316528d0*(tk*tk*tk)
+     Del = 57.7d0 - 0.118d0*tk
+!    "x2" term often neglected (assumed = 1) in applications of Weiss's (1974) equation 9
+!    x2 = 1 - x1 = 1 - xCO2 (it is very close to 1, but not quite)
+!    Let's assume that xCO2 = fCO2. Resulting fugcoeff is identical to 8th digit after the decimal.
+     xCO2approx = dfCO2 * 1.e-6_wp
+     xc2 = (1.0d0 - xCO2approx)**2 
+     fugcoeff = exp( Ptot*(B + 2.0d0*xc2*Del)/(Rgas_atm*tk) )
+     dpCO2 = dfCO2 / fugcoeff
+     pCO2(i) = REAL(dpCO2)
+  END DO
+
+  RETURN
+END SUBROUTINE f2pCO2
+
+END MODULE mocsy_mainmod
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/mocsy_phsolvers.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/mocsy_phsolvers.F90	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/mocsy_phsolvers.F90	(revision 8201)
@@ -0,0 +1,860 @@
+!> \file mocsy_phsolvers.f90
+!! \BRIEF 
+!> Module with routines needed to solve pH-total alkalinity equation (Munhoven, 2013, GMD)
+MODULE mocsy_phsolvers
+!   Module of fastest solvers from Munhoven (2013, Geosci. Model Dev., 6, 1367-1388)
+!   ! Taken from SolveSAPHE (mod_phsolvers.F90) & adapted very slightly for use with mocsy
+!   ! SolveSaphe is distributed under the GNU Lesser General Public License
+!   ! mocsy is distributed under the MIT License
+!
+! Modifications J. C. Orr, LSCE/IPSL, CEA-CNRS-UVSQ, France, 11 Sep 2014:
+! 1) kept only the 3 fastest solvers (atgen, atsec, atfast) and routines which they call
+! 2) reduced vertical white space: deleted many blank lines & comment lines that served as divisions
+! 3) converted name from .F90 to .f90, deleting a few optional preprocesse if statements
+! 4) read in mocsy computed equilibrium constants (as arguments) instead of USE MOD_CHEMCONST
+! 5) converted routine names from upper case to lower case
+! 6) commented out arguments and equations for NH4 and H2S acid systems
+
+USE mocsy_singledouble
+IMPLICIT NONE
+
+! General parameters
+REAL(KIND=wp), PARAMETER :: pp_rdel_ah_target = 1.E-8_wp
+REAL(KIND=wp), PARAMETER :: pp_ln10 = 2.302585092994045684018_wp
+
+! Maximum number of iterations for each method
+INTEGER, PARAMETER :: jp_maxniter_atgen    = 50
+INTEGER, PARAMETER :: jp_maxniter_atsec    = 50
+INTEGER, PARAMETER :: jp_maxniter_atfast   = 50
+
+! Bookkeeping variables for each method
+! - SOLVE_AT_GENERAL
+INTEGER :: niter_atgen    = jp_maxniter_atgen
+
+! - SOLVE_AT_GENERAL_SEC
+INTEGER :: niter_atsec    = jp_maxniter_atsec
+
+! - SOLVE_AT_FAST (variant of SOLVE_AT_GENERAL w/o bracketing
+INTEGER :: niter_atfast   = jp_maxniter_atfast
+
+! Keep the following functions private to avoid conflicts with
+! other modules that provide similar ones.
+!PRIVATE AHINI_FOR_AT
+
+CONTAINS
+!===============================================================================
+SUBROUTINE anw_infsup(p_dictot, p_bortot,                                     &
+                      p_po4tot, p_siltot,                                     &
+                      p_so4tot, p_flutot,                                     &
+                      p_alknw_inf, p_alknw_sup)
+
+! Subroutine returns the lower and upper bounds of "non-water-selfionization"
+! contributions to total alkalinity (the infimum and the supremum), i.e
+! inf(TA - [OH-] + [H+]) and sup(TA - [OH-] + [H+])
+
+USE mocsy_singledouble
+IMPLICIT NONE
+
+! Argument variables
+REAL(KIND=wp), INTENT(IN)  :: p_dictot
+REAL(KIND=wp), INTENT(IN)  :: p_bortot
+REAL(KIND=wp), INTENT(IN)  :: p_po4tot
+REAL(KIND=wp), INTENT(IN)  :: p_siltot
+!REAL(KIND=wp), INTENT(IN)  :: p_nh4tot
+!REAL(KIND=wp), INTENT(IN)  :: p_h2stot
+REAL(KIND=wp), INTENT(IN)  :: p_so4tot
+REAL(KIND=wp), INTENT(IN)  :: p_flutot
+REAL(KIND=wp), INTENT(OUT) :: p_alknw_inf
+REAL(KIND=wp), INTENT(OUT) :: p_alknw_sup
+
+p_alknw_inf =  -p_po4tot - p_so4tot - p_flutot
+p_alknw_sup =   p_dictot + p_dictot + p_bortot &
+              + p_po4tot + p_po4tot + p_siltot !&
+!             + p_nh4tot + p_h2stot
+
+RETURN
+END SUBROUTINE anw_infsup
+
+!===============================================================================
+
+FUNCTION equation_at(p_alktot, p_h,       p_dictot, p_bortot,                 &
+                     p_po4tot, p_siltot,                                      &
+                     p_so4tot, p_flutot,                                      &
+                     K0, K1, K2, Kb, Kw, Ks, Kf, K1p, K2p, K3p, Ksi,          &
+                     p_deriveqn)
+
+USE mocsy_singledouble
+IMPLICIT NONE
+REAL(KIND=wp) :: equation_at
+
+! Argument variables
+REAL(KIND=wp), INTENT(IN)            :: p_alktot
+REAL(KIND=wp), INTENT(IN)            :: p_h
+REAL(KIND=wp), INTENT(IN)            :: p_dictot
+REAL(KIND=wp), INTENT(IN)            :: p_bortot
+REAL(KIND=wp), INTENT(IN)            :: p_po4tot
+REAL(KIND=wp), INTENT(IN)            :: p_siltot
+!REAL(KIND=wp), INTENT(IN)            :: p_nh4tot
+!REAL(KIND=wp), INTENT(IN)            :: p_h2stot
+REAL(KIND=wp), INTENT(IN)            :: p_so4tot
+REAL(KIND=wp), INTENT(IN)            :: p_flutot
+REAL(KIND=wp), INTENT(IN)            :: K0, K1, K2, Kb, Kw, Ks, Kf
+REAL(KIND=wp), INTENT(IN)            :: K1p, K2p, K3p, Ksi
+REAL(KIND=wp), INTENT(OUT), OPTIONAL :: p_deriveqn
+
+! Local variables 
+!-----------------
+REAL(KIND=wp) :: znumer_dic, zdnumer_dic, zdenom_dic, zalk_dic, zdalk_dic
+REAL(KIND=wp) :: znumer_bor, zdnumer_bor, zdenom_bor, zalk_bor, zdalk_bor
+REAL(KIND=wp) :: znumer_po4, zdnumer_po4, zdenom_po4, zalk_po4, zdalk_po4
+REAL(KIND=wp) :: znumer_sil, zdnumer_sil, zdenom_sil, zalk_sil, zdalk_sil
+REAL(KIND=wp) :: znumer_nh4, zdnumer_nh4, zdenom_nh4, zalk_nh4, zdalk_nh4
+REAL(KIND=wp) :: znumer_h2s, zdnumer_h2s, zdenom_h2s, zalk_h2s, zdalk_h2s
+REAL(KIND=wp) :: znumer_so4, zdnumer_so4, zdenom_so4, zalk_so4, zdalk_so4
+REAL(KIND=wp) :: znumer_flu, zdnumer_flu, zdenom_flu, zalk_flu, zdalk_flu
+REAL(KIND=wp) ::                                      zalk_wat, zdalk_wat
+REAL(KIND=wp) :: aphscale
+
+! TOTAL H+ scale: conversion factor for Htot = aphscale * Hfree
+aphscale = 1._wp + p_so4tot/Ks
+
+! H2CO3 - HCO3 - CO3 : n=2, m=0
+znumer_dic = 2._wp*K1*K2 + p_h*       K1
+zdenom_dic =       K1*K2 + p_h*(      K1 + p_h)
+zalk_dic   = p_dictot * (znumer_dic/zdenom_dic)
+
+! B(OH)3 - B(OH)4 : n=1, m=0
+znumer_bor =       Kb
+zdenom_bor =       Kb + p_h
+zalk_bor   = p_bortot * (znumer_bor/zdenom_bor)
+
+! H3PO4 - H2PO4 - HPO4 - PO4 : n=3, m=1
+znumer_po4 = 3._wp*K1p*K2p*K3p + p_h*(2._wp*K1p*K2p + p_h* K1p)
+zdenom_po4 =       K1p*K2p*K3p + p_h*(      K1p*K2p + p_h*(K1p + p_h))
+zalk_po4   = p_po4tot * (znumer_po4/zdenom_po4 - 1._wp) ! Zero level of H3PO4 = 1
+
+! H4SiO4 - H3SiO4 : n=1, m=0
+znumer_sil =       Ksi
+zdenom_sil =       Ksi + p_h
+zalk_sil   = p_siltot * (znumer_sil/zdenom_sil)
+
+! NH4 - NH3 : n=1, m=0
+!znumer_nh4 =       api1_nh4
+!zdenom_nh4 =       api1_nh4 + p_h
+!zalk_nh4   = p_nh4tot * (znumer_nh4/zdenom_nh4)
+! Note: api1_nh4 = Knh4
+
+! H2S - HS : n=1, m=0
+!znumer_h2s =       api1_h2s
+!zdenom_h2s =       api1_h2s + p_h
+!zalk_h2s   = p_h2stot * (znumer_h2s/zdenom_h2s)
+! Note: api1_h2s = Kh2s
+
+! HSO4 - SO4 : n=1, m=1
+znumer_so4 =       Ks
+zdenom_so4 =       Ks + p_h
+zalk_so4   = p_so4tot * (znumer_so4/zdenom_so4 - 1._wp)
+
+! HF - F : n=1, m=1
+znumer_flu =       Kf
+zdenom_flu =       Kf + p_h
+zalk_flu   = p_flutot * (znumer_flu/zdenom_flu - 1._wp)
+
+! H2O - OH
+zalk_wat   = Kw/p_h - p_h/aphscale
+
+equation_at =    zalk_dic + zalk_bor + zalk_po4 + zalk_sil &
+               + zalk_so4 + zalk_flu                       &
+               + zalk_wat - p_alktot
+
+IF(PRESENT(p_deriveqn)) THEN
+   ! H2CO3 - HCO3 - CO3 : n=2
+   zdnumer_dic = K1*K1*K2 + p_h*(4._wp*K1*K2               &
+                          + p_h*       K1    )
+   zdalk_dic   = -p_dictot*(zdnumer_dic/zdenom_dic**2)
+
+   ! B(OH)3 - B(OH)4 : n=1
+   zdnumer_bor = Kb
+   zdalk_bor   = -p_bortot*(zdnumer_bor/zdenom_bor**2)
+
+   ! H3PO4 - H2PO4 - HPO4 - PO4 : n=3
+   zdnumer_po4 = K1p*K2p*K1p*K2p*K3p + p_h*(4._wp*K1p*K1p*K2p*K3p                &
+                                     + p_h*(9._wp*K1p*K2p*K3p + K1p*K1p*K2p      &
+                                     + p_h*(4._wp*K1p*K2p                        &
+                                     + p_h*       K1p)))
+   zdalk_po4   = -p_po4tot * (zdnumer_po4/zdenom_po4**2)
+
+   ! H4SiO4 - H3SiO4 : n=1
+   zdnumer_sil = Ksi
+   zdalk_sil   = -p_siltot * (zdnumer_sil/zdenom_sil**2)
+
+!  ! NH4 - NH3 : n=1
+!  zdnumer_nh4 = Knh4
+!  zdalk_nh4   = -p_nh4tot * (zdnumer_nh4/zdenom_nh4**2)
+
+!  ! H2S - HS : n=1
+!  zdnumer_h2s = api1_h2s
+!  zdalk_h2s   = -p_h2stot * (zdnumer_h2s/zdenom_h2s**2)
+
+   ! HSO4 - SO4 : n=1
+   zdnumer_so4 = Ks
+   zdalk_so4   = -p_so4tot * (zdnumer_so4/zdenom_so4**2)
+
+   ! HF - F : n=1
+   zdnumer_flu = Kf
+   zdalk_flu   = -p_flutot * (zdnumer_flu/zdenom_flu**2)
+
+!  p_deriveqn =   zdalk_dic + zdalk_bor + zdalk_po4 + zdalk_sil &
+!               + zdalk_nh4 + zdalk_h2s + zdalk_so4 + zdalk_flu &
+!               - Kw/p_h**2 - 1._wp/aphscale
+   p_deriveqn =   zdalk_dic + zdalk_bor + zdalk_po4 + zdalk_sil &
+                                        + zdalk_so4 + zdalk_flu &
+                - Kw/p_h**2 - 1._wp/aphscale
+ENDIF
+RETURN
+END FUNCTION equation_at
+
+!===============================================================================
+
+SUBROUTINE ahini_for_at(p_alkcb, p_dictot, p_bortot, K1, K2, Kb, p_hini)
+
+! Subroutine returns the root for the 2nd order approximation of the
+! DIC -- B_T -- A_CB equation for [H+] (reformulated as a cubic polynomial)
+! around the local minimum, if it exists.
+
+! Returns * 1E-03_wp if p_alkcb <= 0
+!         * 1E-10_wp if p_alkcb >= 2*p_dictot + p_bortot
+!         * 1E-07_wp if 0 < p_alkcb < 2*p_dictot + p_bortot
+!                    and the 2nd order approximation does not have a solution
+
+!USE MOD_CHEMCONST, ONLY : api1_dic, api2_dic, api1_bor
+
+USE mocsy_singledouble
+IMPLICIT NONE
+
+! Argument variables 
+!--------------------
+REAL(KIND=wp), INTENT(IN)   ::  p_alkcb, p_dictot, p_bortot
+REAL(KIND=wp), INTENT(IN)   ::  K1, K2, Kb
+REAL(KIND=wp), INTENT(OUT)  ::  p_hini
+
+! Local variables 
+!-----------------
+REAL(KIND=wp)  ::  zca, zba
+REAL(KIND=wp)  ::  zd, zsqrtd, zhmin
+REAL(KIND=wp)  ::  za2, za1, za0
+
+IF (p_alkcb <= 0._wp) THEN
+  p_hini = 1.e-3_wp
+ELSEIF (p_alkcb >= (2._wp*p_dictot + p_bortot)) THEN
+  p_hini = 1.e-10_wp
+ELSE
+  zca = p_dictot/p_alkcb
+  zba = p_bortot/p_alkcb
+
+  ! Coefficients of the cubic polynomial
+  za2 = Kb*(1._wp - zba) + K1*(1._wp-zca)
+  za1 = K1*Kb*(1._wp - zba - zca) + K1*K2*(1._wp - (zca+zca))
+  za0 = K1*K2*Kb*(1._wp - zba - (zca+zca))
+                                        ! Taylor expansion around the minimum
+  zd = za2*za2 - 3._wp*za1              ! Discriminant of the quadratic equation
+                                        ! for the minimum close to the root
+
+  IF(zd > 0._wp) THEN                   ! If the discriminant is positive
+    zsqrtd = SQRT(zd)
+    IF(za2 < 0) THEN
+      zhmin = (-za2 + zsqrtd)/3._wp
+    ELSE
+      zhmin = -za1/(za2 + zsqrtd)
+    ENDIF
+    p_hini = zhmin + SQRT(-(za0 + zhmin*(za1 + zhmin*(za2 + zhmin)))/zsqrtd)
+  ELSE
+    p_hini = 1.e-7_wp
+  ENDIF
+
+ENDIF
+RETURN
+END SUBROUTINE ahini_for_at
+
+!===============================================================================
+
+FUNCTION solve_at_general(p_alktot, p_dictot, p_bortot,                       &
+                          p_po4tot, p_siltot,                                 &
+                          p_so4tot, p_flutot,                                 &
+                          K0, K1, K2, Kb, Kw, Ks, Kf, K1p, K2p, K3p, Ksi,     &
+                          p_hini,   p_val)
+
+! Universal pH solver that converges from any given initial value,
+! determines upper an lower bounds for the solution if required
+
+USE mocsy_singledouble
+IMPLICIT NONE
+REAL(KIND=wp) :: SOLVE_AT_GENERAL
+
+! Argument variables 
+!--------------------
+REAL(KIND=wp), INTENT(IN)            :: p_alktot
+REAL(KIND=wp), INTENT(IN)            :: p_dictot
+REAL(KIND=wp), INTENT(IN)            :: p_bortot
+REAL(KIND=wp), INTENT(IN)            :: p_po4tot
+REAL(KIND=wp), INTENT(IN)            :: p_siltot
+!REAL(KIND=wp), INTENT(IN)            :: p_nh4tot
+!REAL(KIND=wp), INTENT(IN)            :: p_h2stot
+REAL(KIND=wp), INTENT(IN)            :: p_so4tot
+REAL(KIND=wp), INTENT(IN)            :: p_flutot
+REAL(KIND=wp), INTENT(IN)            :: K0, K1, K2, Kb, Kw, Ks, Kf
+REAL(KIND=wp), INTENT(IN)            :: K1p, K2p, K3p, Ksi
+REAL(KIND=wp), INTENT(IN), OPTIONAL  :: p_hini
+REAL(KIND=wp), INTENT(OUT), OPTIONAL :: p_val
+
+! Local variables 
+!-----------------
+REAL(KIND=wp)  ::  zh_ini, zh, zh_prev, zh_lnfactor
+REAL(KIND=wp)  ::  zalknw_inf, zalknw_sup
+REAL(KIND=wp)  ::  zh_min, zh_max
+REAL(KIND=wp)  ::  zdelta, zh_delta
+REAL(KIND=wp)  ::  zeqn, zdeqndh, zeqn_absmin
+REAL(KIND=wp)  ::  aphscale
+LOGICAL        :: l_exitnow
+REAL(KIND=wp), PARAMETER :: pz_exp_threshold = 1.0_wp
+
+! TOTAL H+ scale: conversion factor for Htot = aphscale * Hfree
+aphscale = 1._wp + p_so4tot/Ks
+
+IF(PRESENT(p_hini)) THEN
+   zh_ini = p_hini
+ELSE
+   CALL ahini_for_at(p_alktot, p_dictot, p_bortot, K1, K2, Kb, zh_ini)
+ENDIF
+
+ CALL anw_infsup(p_dictot, p_bortot,                                           &
+                 p_po4tot, p_siltot,                                           &
+                 p_so4tot, p_flutot,                                           &
+                 zalknw_inf, zalknw_sup)
+
+zdelta = (p_alktot-zalknw_inf)**2 + 4._wp*Kw/aphscale
+
+IF(p_alktot >= zalknw_inf) THEN
+   zh_min = 2._wp*Kw /( p_alktot-zalknw_inf + SQRT(zdelta) )
+ELSE
+   zh_min = aphscale*(-(p_alktot-zalknw_inf) + SQRT(zdelta) ) / 2._wp
+ENDIF
+
+zdelta = (p_alktot-zalknw_sup)**2 + 4._wp*Kw/aphscale
+
+IF(p_alktot <= zalknw_sup) THEN
+   zh_max = aphscale*(-(p_alktot-zalknw_sup) + SQRT(zdelta) ) / 2._wp
+ELSE
+   zh_max = 2._wp*Kw /( p_alktot-zalknw_sup + SQRT(zdelta) )
+ENDIF
+
+zh = MAX(MIN(zh_max, zh_ini), zh_min)
+niter_atgen        = 0                 ! Reset counters of iterations
+zeqn_absmin        = HUGE(1._wp)
+
+DO
+   IF(niter_atgen >= jp_maxniter_atgen) THEN
+      zh = -1._wp
+      EXIT
+   ENDIF
+
+   zh_prev = zh
+   zeqn = equation_at(p_alktot, zh,       p_dictot, p_bortot,                  &
+                      p_po4tot, p_siltot,                                      &
+                      p_so4tot, p_flutot,                                      &
+                      K0, K1, K2, Kb, Kw, Ks, Kf, K1p, K2p, K3p, Ksi,          &
+                      P_DERIVEQN = zdeqndh)
+
+   ! Adapt bracketing interval
+   IF(zeqn > 0._wp) THEN
+      zh_min = zh_prev
+   ELSEIF(zeqn < 0._wp) THEN
+      zh_max = zh_prev
+   ELSE
+      ! zh is the root; unlikely but, one never knows
+      EXIT
+   ENDIF
+
+   ! Now determine the next iterate zh
+   niter_atgen = niter_atgen + 1
+
+   IF(ABS(zeqn) >= 0.5_wp*zeqn_absmin) THEN
+      ! if the function evaluation at the current point is
+      ! not decreasing faster than with a bisection step (at least linearly)
+      ! in absolute value take one bisection step on [ph_min, ph_max]
+      ! ph_new = (ph_min + ph_max)/2d0
+      !
+      ! In terms of [H]_new:
+      ! [H]_new = 10**(-ph_new)
+      !         = 10**(-(ph_min + ph_max)/2d0)
+      !         = SQRT(10**(-(ph_min + phmax)))
+      !         = SQRT(zh_max * zh_min)
+      zh = SQRT(zh_max * zh_min)
+      zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below
+   ELSE
+      ! dzeqn/dpH = dzeqn/d[H] * d[H]/dpH
+      !           = -zdeqndh * LOG(10) * [H]
+      ! \Delta pH = -zeqn/(zdeqndh*d[H]/dpH) = zeqn/(zdeqndh*[H]*LOG(10))
+      !
+      ! pH_new = pH_old + \deltapH
+      !
+      ! [H]_new = 10**(-pH_new)
+      !         = 10**(-pH_old - \Delta pH)
+      !         = [H]_old * 10**(-zeqn/(zdeqndh*[H]_old*LOG(10)))
+      !         = [H]_old * EXP(-LOG(10)*zeqn/(zdeqndh*[H]_old*LOG(10)))
+      !         = [H]_old * EXP(-zeqn/(zdeqndh*[H]_old))
+
+      zh_lnfactor = -zeqn/(zdeqndh*zh_prev)
+
+      IF(ABS(zh_lnfactor) > pz_exp_threshold) THEN
+         zh          = zh_prev*EXP(zh_lnfactor)
+      ELSE
+         zh_delta    = zh_lnfactor*zh_prev
+         zh          = zh_prev + zh_delta
+      ENDIF
+
+      IF( zh < zh_min ) THEN
+         ! if [H]_new < [H]_min
+         ! i.e., if ph_new > ph_max then
+         ! take one bisection step on [ph_prev, ph_max]
+         ! ph_new = (ph_prev + ph_max)/2d0
+         ! In terms of [H]_new:
+         ! [H]_new = 10**(-ph_new)
+         !         = 10**(-(ph_prev + ph_max)/2d0)
+         !         = SQRT(10**(-(ph_prev + phmax)))
+         !         = SQRT([H]_old*10**(-ph_max))
+         !         = SQRT([H]_old * zh_min)
+         zh                = SQRT(zh_prev * zh_min)
+         zh_lnfactor       = (zh - zh_prev)/zh_prev ! Required to test convergence below
+      ENDIF
+
+      IF( zh > zh_max ) THEN
+         ! if [H]_new > [H]_max
+         ! i.e., if ph_new < ph_min, then
+         ! take one bisection step on [ph_min, ph_prev]
+         ! ph_new = (ph_prev + ph_min)/2d0
+         ! In terms of [H]_new:
+         ! [H]_new = 10**(-ph_new)
+         !         = 10**(-(ph_prev + ph_min)/2d0)
+         !         = SQRT(10**(-(ph_prev + ph_min)))
+         !         = SQRT([H]_old*10**(-ph_min))
+         !         = SQRT([H]_old * zhmax)
+         zh                = SQRT(zh_prev * zh_max)
+         zh_lnfactor       = (zh - zh_prev)/zh_prev ! Required to test convergence below
+      ENDIF
+   ENDIF
+
+   zeqn_absmin = MIN( ABS(zeqn), zeqn_absmin)
+
+   ! Stop iterations once |\delta{[H]}/[H]| < rdel
+   ! <=> |(zh - zh_prev)/zh_prev| = |EXP(-zeqn/(zdeqndh*zh_prev)) -1| < rdel
+   ! |EXP(-zeqn/(zdeqndh*zh_prev)) -1| ~ |zeqn/(zdeqndh*zh_prev)|
+
+   ! Alternatively:
+   ! |\Delta pH| = |zeqn/(zdeqndh*zh_prev*LOG(10))|
+   !             ~ 1/LOG(10) * |\Delta [H]|/[H]
+   !             < 1/LOG(10) * rdel
+
+   ! Hence |zeqn/(zdeqndh*zh)| < rdel
+
+   ! rdel <-- pp_rdel_ah_target
+
+   l_exitnow = (ABS(zh_lnfactor) < pp_rdel_ah_target)
+
+   IF(l_exitnow) EXIT
+ENDDO
+
+solve_at_general = zh
+
+IF(PRESENT(p_val)) THEN
+   IF(zh > 0._wp) THEN
+      p_val = equation_at(p_alktot, zh,       p_dictot, p_bortot,              &
+                          p_po4tot, p_siltot,                                  &
+                          p_so4tot, p_flutot,                                  &
+                          K0, K1, K2, Kb, Kw, Ks, Kf, K1p, K2p, K3p, Ksi)    
+   ELSE
+      p_val = HUGE(1._wp)
+   ENDIF
+ENDIF
+RETURN
+END FUNCTION solve_at_general
+
+!===============================================================================
+
+FUNCTION solve_at_general_sec(p_alktot, p_dictot, p_bortot,                   &
+                              p_po4tot, p_siltot,                             &
+                              p_so4tot, p_flutot,                             &
+                              K0, K1, K2, Kb, Kw, Ks, Kf, K1p, K2p, K3p, Ksi, &
+                              p_hini,   p_val) 
+
+! Universal pH solver that converges from any given initial value,
+! determines upper an lower bounds for the solution if required
+
+!USE MOD_CHEMCONST, ONLY: api1_wat, aphscale
+USE mocsy_singledouble
+IMPLICIT NONE
+REAL(KIND=wp) :: SOLVE_AT_GENERAL_SEC
+
+! Argument variables 
+REAL(KIND=wp), INTENT(IN)            :: p_alktot
+REAL(KIND=wp), INTENT(IN)            :: p_dictot
+REAL(KIND=wp), INTENT(IN)            :: p_bortot
+REAL(KIND=wp), INTENT(IN)            :: p_po4tot
+REAL(KIND=wp), INTENT(IN)            :: p_siltot
+!REAL(KIND=wp), INTENT(IN)            :: p_nh4tot
+!REAL(KIND=wp), INTENT(IN)            :: p_h2stot
+REAL(KIND=wp), INTENT(IN)            :: p_so4tot
+REAL(KIND=wp), INTENT(IN)            :: p_flutot
+REAL(KIND=wp), INTENT(IN)            :: K0, K1, K2, Kb, Kw, Ks, Kf
+REAL(KIND=wp), INTENT(IN)            :: K1p, K2p, K3p, Ksi
+REAL(KIND=wp), INTENT(IN), OPTIONAL  :: p_hini
+REAL(KIND=wp), INTENT(OUT), OPTIONAL :: p_val
+
+! Local variables
+REAL(KIND=wp)  ::  zh_ini, zh, zh_1, zh_2, zh_delta
+REAL(KIND=wp)  ::  zalknw_inf, zalknw_sup
+REAL(KIND=wp)  ::  zh_min, zh_max
+REAL(KIND=wp)  ::  zeqn, zeqn_1, zeqn_2, zeqn_absmin
+REAL(KIND=wp)  ::  zdelta
+REAL(KIND=wp)  ::  aphscale
+LOGICAL        ::  l_exitnow
+
+! TOTAL H+ scale: conversion factor for Htot = aphscale * Hfree
+aphscale = 1._wp + p_so4tot/Ks
+
+IF(PRESENT(p_hini)) THEN
+   zh_ini = p_hini
+ELSE
+   CALL ahini_for_at(p_alktot, p_dictot, p_bortot, K1, K2, Kb, zh_ini)
+ENDIF
+
+ CALL anw_infsup(p_dictot, p_bortot,                                      &
+                 p_po4tot, p_siltot,                                      &
+                 p_so4tot, p_flutot,                                      &
+                 zalknw_inf, zalknw_sup)
+
+zdelta = (p_alktot-zalknw_inf)**2 + 4._wp*Kw/aphscale
+
+IF(p_alktot >= zalknw_inf) THEN
+   zh_min = 2._wp*Kw /( p_alktot-zalknw_inf + SQRT(zdelta) )
+ELSE
+   zh_min = aphscale*(-(p_alktot-zalknw_inf) + SQRT(zdelta) ) / 2._wp
+ENDIF
+
+zdelta = (p_alktot-zalknw_sup)**2 + 4._wp*Kw/aphscale
+
+IF(p_alktot <= zalknw_sup) THEN
+   zh_max = aphscale*(-(p_alktot-zalknw_sup) + SQRT(zdelta) ) / 2._wp
+ELSE
+   zh_max = 2._wp*Kw /( p_alktot-zalknw_sup + SQRT(zdelta) )
+ENDIF
+
+zh = MAX(MIN(zh_max, zh_ini), zh_min)
+niter_atsec        = 0                 ! Reset counters of iterations
+
+! Prepare the secant iterations: two initial (zh, zeqn) pairs are required
+! We have the starting value, that needs to be completed by the evaluation
+! of the equation value it produces.
+
+! Complete the initial value with its equation evaluation
+! (will take the role of the $n-2$ iterate at the first secant evaluation)
+
+niter_atsec = 0                        ! zh_2 is the initial value;
+
+zh_2   = zh
+zeqn_2 = equation_at(p_alktot, zh_2,     p_dictot, p_bortot,                 &
+                     p_po4tot, p_siltot,                                     &
+                     p_so4tot, p_flutot,                                     &
+                     K0, K1, K2, Kb, Kw, Ks, Kf, K1p, K2p, K3p, Ksi)
+
+zeqn_absmin        = ABS(zeqn_2)
+
+! Adapt bracketing interval and heuristically set zh_1
+IF(zeqn_2 < 0._wp) THEN
+                                       ! If zeqn_2 < 0, then we adjust zh_max:
+                                       ! we can be sure that zh_min < zh_2 < zh_max.
+   zh_max = zh_2
+                                       ! for zh_1, try 25% (0.1 pH units) below the current zh_max,
+                                       ! but stay above SQRT(zh_min*zh_max), which would be equivalent
+                                       ! to a bisection step on [pH@zh_min, pH@zh_max]
+   zh_1   = MAX(zh_max/1.25_wp, SQRT(zh_min*zh_max))
+ELSEIF(zeqn_2 > 0._wp) THEN
+                                       ! If zeqn_2 < 0, then we adjust zh_min:
+                                       ! we can be sure that zh_min < zh_2 < zh_max.
+   zh_min = zh_2
+                                       ! for zh_1, try 25% (0.1 pH units) above the current zh_min,
+                                       ! but stay below SQRT(zh_min*zh_max) which would be equivalent
+                                       ! to a bisection step on [pH@zh_min, pH@zh_max]
+   zh_1   = MIN(zh_min*1.25_wp, SQRT(zh_min*zh_max))
+ELSE ! we have got the root; unlikely, but one never knows
+   solve_at_general_sec = zh_2
+   IF(PRESENT(p_val)) p_val = zeqn_2
+   RETURN
+ENDIF
+
+! We now have the first pair completed (zh_2, zeqn_2).
+! Define the second one (zh_1, zeqn_1), which is also the first iterate.
+! zh_1 has already been set above
+niter_atsec = 1                        ! Update counter of iterations
+
+zeqn_1 = equation_at(p_alktot, zh_1,       p_dictot, p_bortot,                 &
+                     p_po4tot, p_siltot,                                       &
+                     p_so4tot, p_flutot,                                       &
+                     K0, K1, K2, Kb, Kw, Ks, Kf, K1p, K2p, K3p, Ksi)
+
+! Adapt bracketing interval: we know that zh_1 <= zh <= zh_max (if zeqn_1 > 0)
+! or zh_min <= zh <= zh_1 (if zeqn_1 < 0), so this can always be done
+IF(zeqn_1 > 0._wp) THEN
+   zh_min = zh_1
+ELSEIF(zeqn_1 < 0._wp) THEN
+   zh_max = zh_1
+ELSE ! zh_1 is the root
+   solve_at_general_sec = zh_1
+   IF(PRESENT(p_val)) p_val = zeqn_1
+ENDIF
+
+IF(ABS(zeqn_1) > zeqn_absmin) THEN     ! Swap zh_2 and zh_1 if ABS(zeqn_2) < ABS(zeqn_1)
+                                       ! so that zh_2 and zh_1 lead to decreasing equation
+                                       ! values (in absolute value)
+   zh     = zh_1
+   zeqn   = zeqn_1
+   zh_1   = zh_2
+   zeqn_1 = zeqn_2
+   zh_2   = zh
+   zeqn_2 = zeqn
+ELSE
+   zeqn_absmin = ABS(zeqn_1)
+ENDIF
+
+! Pre-calculate the first secant iterate (this is the second iterate)
+niter_atsec = 2
+
+zh_delta = -zeqn_1/((zeqn_2-zeqn_1)/(zh_2 - zh_1))
+zh = zh_1 + zh_delta
+
+! Make sure that zh_min < zh < zh_max (if not,
+! bisect around zh_1 which is the best estimate)
+IF (zh > zh_max) THEN                  ! this can only happen if zh_2 < zh_1
+                                       ! and zeqn_2 > zeqn_1 > 0
+   zh = SQRT(zh_1*zh_max)
+ENDIF
+
+IF (zh < zh_min) THEN                  ! this can only happen if zh_2 > zh_1
+                                       ! and zeqn_2 < zeqn_1 < 0
+   zh = SQRT(zh_1*zh_min)
+ENDIF
+
+DO
+   IF(niter_atsec >= jp_maxniter_atsec) THEN
+      zh = -1._wp
+      EXIT
+   ENDIF
+
+   zeqn = equation_at(p_alktot, zh,       p_dictot, p_bortot,                  &
+                      p_po4tot, p_siltot,                                      &
+                      p_so4tot, p_flutot,                                      &
+                      K0, K1, K2, Kb, Kw, Ks, Kf, K1p, K2p, K3p, Ksi)
+
+   ! Adapt bracketing interval: since initially, zh_min <= zh <= zh_max
+   ! we are sure that zh will improve either bracket, depending on the sign
+   ! of zeqn
+   IF(zeqn > 0._wp) THEN
+     zh_min = zh
+   ELSEIF(zeqn < 0._wp) THEN
+     zh_max = zh
+   ELSE
+     ! zh is the root
+     EXIT
+   ENDIF
+
+   ! start calculation of next iterate
+   niter_atsec = niter_atsec + 1
+
+   zh_2   = zh_1
+   zeqn_2 = zeqn_1
+   zh_1   = zh
+   zeqn_1 = zeqn
+
+   IF(ABS(zeqn) >= 0.5_wp*zeqn_absmin) THEN
+      ! if the function evaluation at the current point
+      ! is not decreasing faster in absolute value than
+      ! we may expect for a bisection step, then take
+      ! one bisection step on [ph_min, ph_max]
+      ! ph_new = (ph_min + ph_max)/2d0
+      ! In terms of [H]_new:
+      ! [H]_new = 10**(-ph_new)
+      !         = 10**(-(ph_min + ph_max)/2d0)
+      !         = SQRT(10**(-(ph_min + phmax)))
+      !         = SQRT(zh_max * zh_min)
+      zh                = SQRT(zh_max * zh_min)
+      zh_delta           = zh - zh_1
+   ELSE
+      ! \Delta H = -zeqn_1*(h_2 - h_1)/(zeqn_2 - zeqn_1) 
+      ! H_new = H_1 + \Delta H
+      zh_delta = -zeqn_1/((zeqn_2-zeqn_1)/(zh_2 - zh_1))
+      zh       = zh_1 + zh_delta
+
+      IF( zh < zh_min ) THEN
+         ! if [H]_new < [H]_min
+         ! i.e., if ph_new > ph_max then
+         ! take one bisection step on [ph_prev, ph_max]
+         ! ph_new = (ph_prev + ph_max)/2d0
+         ! In terms of [H]_new:
+         ! [H]_new = 10**(-ph_new)
+         !         = 10**(-(ph_prev + ph_max)/2d0)
+         !         = SQRT(10**(-(ph_prev + phmax)))
+         !         = SQRT([H]_old*10**(-ph_max))
+         !         = SQRT([H]_old * zh_min)
+         zh                = SQRT(zh_1 * zh_min)
+         zh_delta          = zh - zh_1
+      ENDIF
+
+      IF( zh > zh_max ) THEN
+         ! if [H]_new > [H]_max
+         ! i.e., if ph_new < ph_min, then
+         ! take one bisection step on [ph_min, ph_prev]
+         ! ph_new = (ph_prev + ph_min)/2d0
+         ! In terms of [H]_new:
+         ! [H]_new = 10**(-ph_new)
+         !         = 10**(-(ph_prev + ph_min)/2d0)
+         !         = SQRT(10**(-(ph_prev + ph_min)))
+         !         = SQRT([H]_old*10**(-ph_min))
+         !         = SQRT([H]_old * zhmax)
+         zh                 = SQRT(zh_1 * zh_max)
+         zh_delta           = zh - zh_1
+      ENDIF
+   ENDIF
+
+   zeqn_absmin = MIN(ABS(zeqn), zeqn_absmin)
+
+   ! Stop iterations once |([H]-[H_1])/[H_1]| < rdel
+   l_exitnow = (ABS(zh_delta) < pp_rdel_ah_target*zh_1)
+
+   IF(l_exitnow) EXIT
+ENDDO
+
+SOLVE_AT_GENERAL_SEC = zh
+
+IF(PRESENT(p_val)) THEN
+   IF(zh > 0._wp) THEN
+      p_val = equation_at(p_alktot, zh,       p_dictot, p_bortot,              &
+                          p_po4tot, p_siltot,                                  &
+                          p_so4tot, p_flutot,                                  &
+                          K0, K1, K2, Kb, Kw, Ks, Kf, K1p, K2p, K3p, Ksi)
+   ELSE
+     p_val = HUGE(1._wp)
+   ENDIF
+ENDIF
+
+RETURN
+END FUNCTION SOLVE_AT_GENERAL_SEC
+
+!===============================================================================
+
+FUNCTION SOLVE_AT_FAST(p_alktot, p_dictot, p_bortot,                          &
+                       p_po4tot, p_siltot,                                    &
+                       p_so4tot, p_flutot,                                    & 
+                       K0, K1, K2, Kb, Kw, Ks, Kf, K1p, K2p, K3p, Ksi,        &
+                       p_hini,   p_val)
+
+! Fast version of SOLVE_AT_GENERAL, without any bounds checking.
+
+USE mocsy_singledouble
+IMPLICIT NONE
+REAL(KIND=wp) :: SOLVE_AT_FAST
+
+! Argument variables 
+REAL(KIND=wp), INTENT(IN)            :: p_alktot
+REAL(KIND=wp), INTENT(IN)            :: p_dictot
+REAL(KIND=wp), INTENT(IN)            :: p_bortot
+REAL(KIND=wp), INTENT(IN)            :: p_po4tot
+REAL(KIND=wp), INTENT(IN)            :: p_siltot
+!REAL(KIND=wp), INTENT(IN)            :: p_nh4tot
+!REAL(KIND=wp), INTENT(IN)            :: p_h2stot
+REAL(KIND=wp), INTENT(IN)            :: p_so4tot
+REAL(KIND=wp), INTENT(IN)            :: p_flutot
+REAL(KIND=wp), INTENT(IN)            :: K0, K1, K2, Kb, Kw, Ks, Kf
+REAL(KIND=wp), INTENT(IN)            :: K1p, K2p, K3p, Ksi
+REAL(KIND=wp), INTENT(IN), OPTIONAL  :: p_hini
+REAL(KIND=wp), INTENT(OUT), OPTIONAL :: p_val
+
+! Local variables
+REAL(KIND=wp)  ::  zh_ini, zh, zh_prev, zh_lnfactor
+REAL(KIND=wp)  ::  zhdelta
+REAL(KIND=wp)  ::  zeqn, zdeqndh
+!REAL(KIND=wp)  ::  aphscale
+LOGICAL        :: l_exitnow
+REAL(KIND=wp), PARAMETER :: pz_exp_threshold = 1.0_wp
+
+! TOTAL H+ scale: conversion factor for Htot = aphscale * Hfree
+!aphscale = 1._wp + p_so4tot/Ks
+
+IF(PRESENT(p_hini)) THEN
+   zh_ini = p_hini
+ELSE
+   CALL AHINI_FOR_AT(p_alktot, p_dictot, p_bortot, K1, K2, Kb, zh_ini)
+ENDIF
+zh = zh_ini
+
+niter_atfast    = 0                 ! Reset counters of iterations
+DO
+   niter_atfast = niter_atfast + 1
+   IF(niter_atfast > jp_maxniter_atfast) THEN
+      zh = -1._wp
+      EXIT
+   ENDIF
+
+   zh_prev = zh
+
+   zeqn = equation_at(p_alktot, zh,       p_dictot, p_bortot,                  &
+                      p_po4tot, p_siltot,                                      &
+                      p_so4tot, p_flutot,                                      & 
+                      K0, K1, K2, Kb, Kw, Ks, Kf, K1p, K2p, K3p, Ksi,          &
+                      P_DERIVEQN = zdeqndh)
+
+   IF(zeqn == 0._wp) EXIT               ! zh is the root
+
+   zh_lnfactor = -zeqn/(zdeqndh*zh_prev)
+   IF(ABS(zh_lnfactor) > pz_exp_threshold) THEN
+      zh          = zh_prev*EXP(zh_lnfactor)
+   ELSE
+      zhdelta     = zh_lnfactor*zh_prev
+      zh          = zh_prev + zhdelta
+   ENDIF
+
+   ! Stop iterations once |\delta{[H]}/[H]| < rdel
+   ! <=> |(zh - zh_prev)/zh_prev| = |EXP(-zeqn/(zdeqndh*zh_prev)) -1| < rdel
+   ! |EXP(-zeqn/(zdeqndh*zh_prev)) -1| ~ |zeqn/(zdeqndh*zh_prev)|
+
+   ! Alternatively:
+   ! |\Delta pH| = |zeqn/(zdeqndh*zh_prev*LOG(10))|
+   !             ~ 1/LOG(10) * |\Delta [H]|/[H]
+   !             < 1/LOG(10) * rdel
+
+   ! Hence |zeqn/(zdeqndh*zh)| < rdel
+
+   ! rdel <- pp_rdel_ah_target
+
+   l_exitnow = (ABS(zh_lnfactor) < pp_rdel_ah_target)
+
+   IF(l_exitnow) EXIT
+ENDDO
+
+SOLVE_AT_FAST = zh
+
+IF(PRESENT(p_val)) THEN
+   IF(zh > 0._wp) THEN
+      p_val = equation_at(p_alktot, zh,       p_dictot, p_bortot,              &
+                          p_po4tot, p_siltot,                                  &
+                          p_so4tot, p_flutot,                                  &
+                          K0, K1, K2, Kb, Kw, Ks, Kf, K1p, K2p, K3p, Ksi)
+   ELSE
+      p_val = HUGE(1._wp)
+   ENDIF
+ENDIF
+
+RETURN
+END FUNCTION solve_at_fast
+!===============================================================================
+
+END MODULE mocsy_phsolvers
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/mocsy_singledouble.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/mocsy_singledouble.F90	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/mocsy_singledouble.F90	(revision 8201)
@@ -0,0 +1,11 @@
+!> \file mocsy_singledouble.f90
+!! \BRIEF 
+!> Module that defines single and double precision - used by all other modules
+MODULE mocsy_singledouble
+! INTEGER, PARAMETER :: r4 = SELECTED_REAL_KIND(6)
+! INTEGER, PARAMETER :: r8 = SELECTED_REAL_KIND(12)
+  INTEGER, PARAMETER :: r4 = KIND(1.0)
+  INTEGER, PARAMETER :: r8 = KIND(1.0d0)
+! INTEGER, PARAMETER :: wp = KIND(1.0d0)
+  INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(12,307)
+END MODULE mocsy_singledouble
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/mocsy_wrapper.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/mocsy_wrapper.F90	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/mocsy_wrapper.F90	(revision 8201)
@@ -0,0 +1,357 @@
+MODULE mocsy_wrapper
+   !!======================================================================
+   !!                         ***  MODULE mocsy_wrapper  ***
+   !! TOP :   MEDUSA
+   !!======================================================================
+   !! History :
+   !!  -   !  2015-06  (A. Yool)             added for UKESM project
+   !!  -   !  2017-04  (A. Yool)             alter optK1K2 to 'w14' option
+   !!----------------------------------------------------------------------
+#if defined key_medusa && defined key_roam
+   !!----------------------------------------------------------------------
+   !!                                        MEDUSA carbonate chemistry
+   !!----------------------------------------------------------------------
+   !!   mocsy_wrapper
+   !!----------------------------------------------------------------------
+
+   USE mocsy_mainmod
+   USE mocsy_gasflux
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC mocsy_interface  ! called in trc_bio_medusa
+   PUBLIC mocsy_carbchem   ! called in trc_bio_medusa
+
+   !!* Substitution
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+! The following is a map of the subroutines contained within this module
+! - mocsy_interface
+!    - CALLS mocsy_carbchem
+!
+! - mocsy_carbchem
+!    - CALLS vars
+!      - CALLS p80
+!      - CALLS constants
+!      - CALLS rho
+!      - CALLS varsolver
+!        - CALLS [phsolvers routines]
+!      - CALLS varsolver (again)
+!    - CALLS x2pCO2atm
+!    - CALLS p2fCO2
+!    - CALLS schmidt_co2
+!    - CALLS surface_K0
+
+CONTAINS
+
+!=======================================================================
+!
+      SUBROUTINE mocsy_interface( temp, sal, alk, dic, sil, phos, &
+           Patm, depth, lat, kw660, xco2, N,                      &
+           ph, pco2, fco2, co2, hco3, co3, OmegaA,                &
+           OmegaC, BetaD, rhoSW, p, tempis,                       &
+           pco2atm, fco2atm, schmidtco2, kwco2, K0,               &
+           co2starair, co2flux, dpco2 )
+!
+!=======================================================================
+!
+! AXY (26/06/15): to preserve both MEDUSA's scalar variables and
+!                 MOCSY's vector variables on code traceability
+!                 grounds, this additional wrapper does a rather
+!                 superfluous conversion between the two; in the
+!                 fullness of time, this should be dispensed with
+!                 and MOCSY used in its full vector form
+!
+        USE mocsy_singledouble
+        IMPLICIT NONE
+
+!> ======================================================================
+!  VARIABLES
+!> ======================================================================
+!
+   INTEGER, INTENT(in) :: N
+!
+!  MEDUSA-side
+!  Input variables
+   REAL(kind=wp), INTENT(in)  :: temp, sal, alk, dic, sil, phos
+   REAL(kind=wp), INTENT(in)  :: Patm, depth, lat, kw660, xco2
+!
+!  Output variables
+   REAL(kind=wp), INTENT(out) :: ph, pco2, fco2, co2, hco3, co3, OmegaA
+   REAL(kind=wp), INTENT(out) :: OmegaC, BetaD, rhoSW, p, tempis
+   REAL(kind=wp), INTENT(out) :: pco2atm, fco2atm, schmidtco2, kwco2, K0
+   REAL(kind=wp), INTENT(out) :: co2starair, co2flux, dpco2
+!
+!  MOCSY-side
+!  Input variables
+   REAL(kind=wp), DIMENSION(N) :: mtemp, msal, malk, mdic, msil, mphos
+   REAL(kind=wp), DIMENSION(N) :: mPatm, mdepth, mlat, mkw660, mxco2
+!
+!  Output variables
+   REAL(kind=wp), DIMENSION(N) :: mph, mpco2, mfco2, mco2, mhco3, mco3, mOmegaA
+   REAL(kind=wp), DIMENSION(N) :: mOmegaC, mBetaD, mrhoSW, mp, mtempis
+   REAL(kind=wp), DIMENSION(N) :: mpco2atm, mfco2atm, mschmidtco2, mkwco2, mK0
+   REAL(kind=wp), DIMENSION(N) :: mco2starair, mco2flux, mdpco2
+!
+!> ----------------------------------------------------------------------
+!  Set MOCSY inputs to equal MEDUSA inputs (amend units here)
+!> ----------------------------------------------------------------------
+!
+      mtemp(1)  = temp         ! degrees C
+      msal(1)   = sal          ! PSU
+      malk(1)   = alk / 1000.  ! meq  / m3 -> eq  / m3
+      mdic(1)   = dic / 1000.  ! mmol / m3 -> mol / m3
+      msil(1)   = sil / 1000.  ! mmol / m3 -> mol / m3
+      mphos(1)  = phos / 1000. ! mmol / m3 -> mol / m3
+      mPatm(1)  = Patm         ! atm
+      mdepth(1) = depth        ! m
+      mlat(1)   = lat          ! degrees N
+      mkw660(1) = kw660        ! m / s
+      mxco2(1)  = xco2         ! ppm
+!
+!> ----------------------------------------------------------------------
+!  Call MOCSY
+!> ----------------------------------------------------------------------
+!
+      CALL mocsy_carbchem( mtemp, msal, malk, mdic, msil, mphos, & ! inputs
+      mPatm, mdepth, mlat, mkw660, mxco2, 1,                     & ! inputs
+      mph, mpco2, mfco2, mco2, mhco3, mco3, mOmegaA,             & ! outputs
+      mOmegaC, mBetaD, mrhoSW, mp, mtempis,                      & ! outputs
+      mpco2atm, mfco2atm, mschmidtco2, mkwco2, mK0,              & ! outputs
+      mco2starair, mco2flux, mdpco2 ) ! outputs
+!
+!> ----------------------------------------------------------------------
+!  Set MOCSY outputs to equal MEDUSA outputs (amend units here)
+!> ----------------------------------------------------------------------
+!
+      ph         = mph(1)                 ! standard units
+      pco2       = mpco2(1)               ! uatm
+      fco2       = mfco2(1)               ! uatm
+      co2        = mco2(1) * 1000.        ! mol / m3 -> mmol / m3
+      hco3       = mhco3(1) * 1000.       ! mol / m3 -> mmol / m3
+      co3        = mco3(1) * 1000.        ! mol / m3 -> mmol / m3
+      OmegaA     = mOmegaA(1)             ! dimensionless
+      OmegaC     = mOmegaC(1)             ! dimensionless
+      BetaD      = mBetaD(1)              ! dimensionless
+      rhoSW      = mrhoSW(1)              ! kg / m3
+      p          = mp(1)                  ! db
+      tempis     = mtempis(1)             ! degrees C
+      pco2atm    = mpco2atm(1)            ! uatm
+      fco2atm    = mfco2atm(1)            ! uatm
+      schmidtco2 = mschmidtco2(1)         ! dimensionless
+      kwco2      = mkwco2(1)              ! m / s
+      K0         = mK0(1)                 ! (mol/kg) / atm
+      co2starair = mco2starair(1) * 1000. ! mol / m3 -> mmol / m3 
+      co2flux    = mco2flux(1) * 1000.    ! mol / m2 / s -> mmol / m2 / s 
+      dpco2      = mdpco2(1)              ! uatm
+
+  RETURN
+
+  END SUBROUTINE
+
+!-----------------------------------------------------------------------
+
+!=======================================================================
+!
+      SUBROUTINE mocsy_carbchem( temp, sal, alk, dic, sil, phos,  &
+           Patm, depth, lat, kw660, xco2, N,                      &
+           ph, pco2, fco2, co2, hco3, co3, OmegaA,                &
+           OmegaC, BetaD, rhoSW, p, tempis,                       &
+           pco2atm, fco2atm, schmidtco2, kwco2, K0,               &
+           co2starair, co2flux, dpco2 )
+!
+!=======================================================================
+! 
+! AXY (23/06/15): MOCSY introduced to MEDUSA to update carbonate
+!                 chemistry for UKESM1 project
+!
+! Orr, J. C. and Epitalon, J.-M.: Improved routines to model the 
+! ocean carbonate system: mocsy 2.0, Geosci. Model Dev., 8, 485-499, 
+! doi:10.5194/gmd-8-485-2015, 2015.
+!
+! "mocsy is a Fortran 95 package designed to compute all ocean
+! carbonate system variables from DIC and total Alk, particularly
+! from models.  It updates previous OCMIP code, avoids 3 common 
+! model approximations, and offers the best-practice constants as 
+! well as more recent options. Its results agree with those from 
+! CO2SYS-MATLAB within 0.005%."
+!
+! Where possible the code remains identical to that published by
+! Orr & Epitalon (2015; henceforth OE15); some consolidation of 
+! MOCSY files has taken place, and the resulting package is 
+! comprised of four modules:
+!                 
+! 1. mocsy_wrapped.f90
+!    - This module contains the interface between MEDUSA and the
+!      main MOCSY routines; it draws from (but is very different
+!      from) the test_mocsy.f90 routine provided by OE15
+!
+! 2. mocsy_singledouble.f90
+!    - This module contains only precision definitions; it is
+!      based on the singledouble.f90 routine provided by OE15
+!
+! 3. mocsy_phsolvers.f90
+!    - This module contains a suite of solvers derived from
+!      Munhoven (2013) and modified by OE15; it is based on the
+!      phsolver.f90 routine provided by OE15
+!
+! 4. mocsy_gasflux.f90
+!    - This module contains a series of subroutines used to 
+!      calculate the air-sea flux of CO2; it consolidates four
+!      MOCSY routines with an OCMIP-2 Schmidt number routine
+!      updated with the new parameterisations of Wanninkhof (2014)
+!
+! 5. mocsy_mainmod.f90
+!    - This module consolidates all of the remaining MOCSY 
+!      functions and subroutines from OE15 into a single file
+!      for convenience
+!
+! NOTE: it is still possible to run PML's carbonate chemistry
+! routine in MEDUSA; at present this remains the default, if
+! less-preferred, routine (i.e. is used if key_mocsy is not
+! present)
+!
+!=======================================================================
+!
+! AXY (05/04/17): alter options to include optK1K2 = 'w14'
+!
+! In conversation with Jim Orr, Waters (2014) is now the 
+! preferred option for optK1K2 in the case of global scale 
+! simulations since this formulation works over broader ranges
+! of temperature (0 < T < 50) and salinity (1 < S < 50).
+!
+! NOTE: *contrary* to the notice above, MEDUSA has now been
+! revised to remove the PML carbonate chemistry routine as part
+! of a wider code review. This routine is not anticipated to be 
+! used again, and has several out of date parameterisations 
+! relative to MOCSY. As a result, key_mocsy is no longer required.
+!
+        USE mocsy_singledouble
+        IMPLICIT NONE
+
+!> ======================================================================
+!  VARIABLES
+!> ======================================================================
+!
+!  Input variables
+   REAL(kind=wp), INTENT(in),  DIMENSION(N) :: temp, sal, alk, dic, sil, phos
+   REAL(kind=wp), INTENT(in),  DIMENSION(N) :: Patm, depth, lat, kw660, xco2
+   INTEGER, INTENT(in) :: N
+!
+!  Output variables
+   REAL(kind=wp), INTENT(out), DIMENSION(N) :: ph, pco2, fco2, co2, hco3, co3, OmegaA
+   REAL(kind=wp), INTENT(out), DIMENSION(N) :: OmegaC, BetaD, rhoSW, p, tempis
+   REAL(kind=wp), INTENT(out), DIMENSION(N) :: pco2atm, fco2atm, schmidtco2, kwco2, K0
+   REAL(kind=wp), INTENT(out), DIMENSION(N) :: co2starair, co2flux, dpco2
+!
+!  Local variables
+   REAL(kind=wp), DIMENSION(N) :: depth0, co2star
+   INTEGER :: i, totdat
+!
+!  "vars" Input options
+   CHARACTER(10) :: optCON, optT, optP, optB, optKf, optK1K2
+!   
+!  initialise depth0 to 0
+   depth0 = 0.0
+   
+!> ======================================================================
+!  CONFIGURE OPTIONS
+!> ======================================================================
+!> OPTIONS: see complete documentation in 'vars' subroutine (in mocsy_mainmod.F90)
+!> AXY (05/04/17): optK1K2 switched from 'm10' to 'w14'
+!> Typical options for MODELS
+   optCON  = 'mol/m3' ! input concentrations are in MOL/M3
+   optT    = 'Tpot'   ! input temperature, variable 'temp', is POTENTIAL temp [°C]
+   optP    = 'm'      ! input variable 'depth' is in METERS
+   optB    = 'l10'    ! Lee et al. (2010) formulation for total boron
+   optK1K2 = 'w14'    ! Lueker et al. (2000) formulations for K1 & K2 (best practices)
+   optKf   = 'dg'     ! Dickson & Riley (1979) formulation for Kf (recommended by Dickson & Goyet, 1994)
+!> optK1K2 = 'l'      ! Lueker et al. (2000) formulations for K1 & K2 (best practices)
+!> optKf   = 'dg'     ! Dickson & Riley (1979) formulation for Kf (recommended by Dickson & Goyet, 1994)
+
+!> ======================================================================
+!  CARBONATE CHEMISTRY CALCULATIONS
+!> ======================================================================
+!> Call mocsy's main subroutine to compute carbonate system variables: 
+!> pH, pCO2, fCO2, CO2*, HCO3- and CO32-, OmegaA, OmegaC, R
+!> FROM temperature, salinity, total alkalinity, dissolved inorganic 
+!> carbon, silica, phosphate, depth (or pressure) (1-D arrays)
+   call vars(ph, pco2, fco2, co2, hco3, co3, OmegaA, OmegaC, BetaD, rhoSW, p, tempis,  &  ! OUTPUT
+             temp, sal, alk, dic, sil, phos, Patm, depth, lat, N,                      &  ! INPUT
+             optCON, optT, optP)
+!            optCON, optT, optP, optB, optK1K2, optKf)                                    ! INPUT OPTIONS
+
+!> ======================================================================
+!  GAS EXCHANGE CALCULATIONS
+!> ======================================================================
+!>
+!> Only calculate gas exchange fields if depth = 0
+   if (depth(1) .eq. 0.0) then
+!
+!     Compute pCO2atm [uatm] from xCO2 [ppm], atmospheric pressure [atm], & vapor pressure of seawater
+!     pCO2atm = (Patm - pH20(i)) * xCO2,   where pH20 is the vapor pressure of seawater [atm]
+      CALL x2pCO2atm(xco2, temp, sal, Patm, N, & ! INPUT
+      pco2atm)                                   ! OUTPUT
+
+!     Compute fCO2atm [uatm] from pCO2atm [uatm] & fugacity coefficient [unitless]
+!     fCO2atm = pCO2atm * fugcoeff,   where fugcoeff= exp(Patm*(B + 2.0*xc2*Del)/(R*tk) )
+      CALL p2fCO2(pco2atm, temp, Patm, depth0, N, & ! INPUT
+      fco2atm)                                      ! OUTPUT
+
+!     Compute Schmidt number for CO2 from potential temperature
+      CALL schmidt_co2(temp, N, & ! INPUT
+      schmidtco2)                 ! OUTPUT
+
+!     Compute transfer velocity for CO2 in m/s (see equation [4] in OCMIP2 design document & OCMIP2 Abiotic HOWTO)
+      kwco2 = kw660 * (660./schmidtco2)**0.5
+
+!     Surface K0 [(mol/kg) / atm] at T, S of surface water
+      CALL surface_K0(temp, sal, N, & ! INPUT
+      K0)                             ! OUTPUT
+
+!     "Atmospheric" [CO2*], air-sea CO2 flux, sfc DIC rate of change, & Delta pCO2
+!     all "lifted" from the gasx.f90 function of MOCSY
+      co2starair = K0 * fco2atm * 1.0e-6_wp * rhoSW ! Equil. [CO2*] for atm CO2 at Patm & sfc-water T,S [mol/m3]
+      co2star    = co2                              ! Oceanic [CO2*] in [mol/m3] from vars.f90
+      co2flux    = kwco2 * (co2starair - co2star)   ! Air-sea CO2 flux [mol/(m2 * s)]
+!     co2ex      = co2flux / dz1                    ! Change in sfc DIC due to gas exchange [mol/[m3 * s)]
+      dpco2      = pco2 - pco2atm                   ! Delta pCO2 (oceanic - atmospheric pCO2) [uatm]
+!     
+   endif
+
+  RETURN
+
+  END SUBROUTINE
+
+!-----------------------------------------------------------------------
+
+!=======================================================================
+!=======================================================================
+!=======================================================================
+
+#  else
+   !!======================================================================
+   !!  Dummy module :                         No MOCSY carbonate chemistry
+   !!======================================================================
+
+CONTAINS
+
+   SUBROUTINE mocsy_interface( kt )                   ! Empty routine
+
+      INTEGER, INTENT( in ) ::   kt
+
+      WRITE(*,*) 'mocsy_interface: You should not have seen this print! error?', kt
+
+   END SUBROUTINE mocsy_interface
+#endif 
+
+   !!======================================================================
+
+END MODULE mocsy_wrapper
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/par_medusa.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/par_medusa.F90	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/par_medusa.F90	(revision 8201)
@@ -0,0 +1,87 @@
+MODULE par_medusa
+   !!======================================================================
+   !!                        ***  par_medusa  ***
+   !! TOP :   set the MEDUSA parameters
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture
+   !!              -   !  2008-08  (K. Popova) adaptation for MEDUSA
+   !!              -   !  2008-11  (A. Yool) continuing adaptation for MEDUSA
+   !!              -   !  2010-03  (A. Yool) updated for branch inclusion
+   !!              -   !  2011-04  (A. Yool) updated for ROAM project
+   !!		   -   !  2013-03  (A. Yool) updated for v3.5 NEMO
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   USE par_pisces , ONLY : jp_pisces       !: number of tracers in PISCES
+   USE par_pisces , ONLY : jp_pisces_2d    !: number of 2D diag in PISCES
+   USE par_pisces , ONLY : jp_pisces_3d    !: number of 3D diag in PISCES
+   USE par_pisces , ONLY : jp_pisces_trd   !: number of biological diag in PISCES
+
+   IMPLICIT NONE
+
+   INTEGER, PARAMETER ::   jp_lm      =  jp_pisces      !: 
+   INTEGER, PARAMETER ::   jp_lm_2d   =  jp_pisces_2d   !:
+   INTEGER, PARAMETER ::   jp_lm_3d   =  jp_pisces_3d   !:
+   INTEGER, PARAMETER ::   jp_lm_trd  =  jp_pisces_trd  !:
+
+#if defined key_medusa
+   !!---------------------------------------------------------------------
+   !!   'key_medusa'                     user defined tracers (MEDUSA)
+   !!---------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_medusa     = .TRUE.   !: PTS flag 
+# if defined key_roam
+   INTEGER, PUBLIC, PARAMETER ::   jp_medusa     =  15      !: number of PTS tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_medusa_2d  =  225     !: additional 2d output arrays (used if ln_diatrc=T)
+   INTEGER, PUBLIC, PARAMETER ::   jp_medusa_3d  =  5       !: additional 3d output arrays (used if ln_diatrc=T)
+   INTEGER, PUBLIC, PARAMETER ::   jp_medusa_trd =  0       !: number of sms trends for MEDUSA
+# else
+   INTEGER, PUBLIC, PARAMETER ::   jp_medusa     =  11      !: number of PTS tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_medusa_2d  =  90      !: additional 2d output arrays (used if ln_diatrc=T)
+   INTEGER, PUBLIC, PARAMETER ::   jp_medusa_3d  =  4       !: additional 3d output arrays (used if ln_diatrc=T)
+   INTEGER, PUBLIC, PARAMETER ::   jp_medusa_trd =  0       !: number of sms trends for MEDUSA
+# endif
+
+   ! assign an index in trc arrays for each PTS prognostic variables
+   INTEGER, PUBLIC, PARAMETER ::   jpchn  =  jp_lm + 1      !: non-diatom chlorophyll concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpchd  =  jp_lm + 2      !: diatom     chlorophyll concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpphn  =  jp_lm + 3      !: non-diatom concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpphd  =  jp_lm + 4      !: diatom     concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpzmi  =  jp_lm + 5      !: microzooplankton concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpzme  =  jp_lm + 6      !: mesozooplankton  concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpdin  =  jp_lm + 7      !: dissolved inorganic nitrogen concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpsil  =  jp_lm + 8      !: silicic acid concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpfer  =  jp_lm + 9      !: total iron concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpdet  =  jp_lm + 10     !: slow-sinking detritus concentration
+   INTEGER, PUBLIC, PARAMETER ::   jppds  =  jp_lm + 11     !: diatom silicon concentration
+# if defined key_roam
+   INTEGER, PUBLIC, PARAMETER ::   jpdtc  =  jp_lm + 12     !: slow-sinking detritus carbon concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpdic  =  jp_lm + 13     !: dissolved inorganic carbon concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpalk  =  jp_lm + 14     !: alkalinity
+   INTEGER, PUBLIC, PARAMETER ::   jpoxy  =  jp_lm + 15     !: dissolved oxygen concentration
+# endif
+
+#else
+   !!---------------------------------------------------------------------
+   !!   Default                           No user defined tracers (MEDUSA)
+   !!---------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_medusa     = .FALSE.  !: MEDUSA flag 
+   INTEGER, PUBLIC, PARAMETER ::   jp_medusa     =  0       !: No MEDUSA tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_medusa_2d  =  0       !: No MEDUSA additional 2d output arrays 
+   INTEGER, PUBLIC, PARAMETER ::   jp_medusa_3d  =  0       !: No MEDUSA additional 3d output arrays 
+   INTEGER, PUBLIC, PARAMETER ::   jp_medusa_trd =  0       !: number of sms trends for MEDUSA
+#endif
+
+   ! Starting/ending PISCES do-loop indices (N.B. no PISCES : jpl_pcs < jpf_pcs the do-loop are never done)
+   INTEGER, PUBLIC, PARAMETER ::   jp_msa0     = jp_lm     + 1              !: First index of MEDUSA passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_msa1     = jp_lm     + jp_medusa      !: Last  index of MEDUSA passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_msa0_2d  = jp_lm_2d  + 1              !: First index of MEDUSA passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_msa1_2d  = jp_lm_2d  + jp_medusa_2d   !: Last  index of MEDUSA passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_msa0_3d  = jp_lm_3d  + 1              !: First index of MEDUSA passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_msa1_3d  = jp_lm_3d  + jp_medusa_3d   !: Last  index of MEDUSA passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_msa0_trd = jp_lm_trd + 1              !: First index of MEDUSA passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_msa1_trd = jp_lm_trd + jp_medusa_trd  !: Last  index of MEDUSA passive tracers
+
+   !!======================================================================
+END MODULE par_medusa
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/sms_medusa.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/sms_medusa.F90	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/sms_medusa.F90	(revision 8201)
@@ -0,0 +1,521 @@
+MODULE sms_medusa 
+   !!----------------------------------------------------------------------
+   !!                     ***  sms_medusa.F90  ***  
+   !! TOP :   MEDUSA  Source Minus Sink variables
+   !!----------------------------------------------------------------------
+   !! History :    -   !  1999-09 (M. Levy)  original code
+   !!              -   !  2000-12 (O. Aumont, E. Kestenare)  add sediment 
+   !!             1.0  !  2005-10 (C. Ethe) F90
+   !!             1.0  !  2005-03  (A-S Kremeur) add fphylab, fzoolab, fdetlab, fdbod
+   !!              -   !  2005-06  (A-S Kremeur) add sedpocb, sedpocn, sedpoca
+   !!             2.0  !  2007-04  (C. Deltel, G. Madec)  Free form and modules
+   !!              -   !  2008-08  (K. Popova) adaptation for MEDUSA
+   !!              -   !  2008-11  (A. Yool) continuing adaptation for MEDUSA
+   !!              -   !  2010-03  (A. Yool) updated for branch inclusion
+   !!              -   !  2011-04  (A. Yool) updated for ROAM project
+   !!----------------------------------------------------------------------
+
+#if defined key_medusa
+   !!----------------------------------------------------------------------
+   !!   'key_medusa'                                         MEDUSA model
+   !!----------------------------------------------------------------------
+   USE par_oce
+   USE par_trc
+
+   IMPLICIT NONE
+   PUBLIC
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   INTEGER ::   numnatp_ref = -1           !! Logical units for namelist medusa
+   INTEGER ::   numnatp_cfg = -1           !! Logical units for namelist medusa
+   INTEGER ::   numonp      = -1           !! Logical unit for namelist medusa output
+
+!!----------------------------------------------------------------------
+!! Biological parameters
+!!----------------------------------------------------------------------
+!!
+!! Primary production and chl related quantities
+   REAL(wp) ::  xxi       !:  conversion factor from gC to mmolN 
+   REAL(wp) ::  xaln      !:  Chl-a specific initial slope of P-I curve for non-diatoms 
+   REAL(wp) ::  xald      !:  Chl-a specific initial slope of P-I curve for diatoms
+   INTEGER  ::  jphy      !:  phytoplankton T-dependent growth switch
+   REAL(wp) ::  xvpn      !:  maximum growth rate for non-diatoms
+   REAL(wp) ::  xvpd      !:  maximum growth rate for diatoms
+   REAL(wp) ::  xthetam   !:  maximum Chl to C ratio for non-diatoms      
+   REAL(wp) ::  xthetamd  !:  maximum Chl to C ratio for diatoms    
+   REAL(wp) ::  jq10      !:  specific Q10 value (jphy==2)    
+!!
+!! Diatom silicon parameters
+   REAL(wp) ::  xsin0     !:  minimum diatom Si:N ratio
+   REAL(wp) ::  xnsi0     !:  minimum diatom N:Si ratio
+   REAL(wp) ::  xuif      !:  hypothetical growth ratio at infinite Si:N ratio
+!!
+!! Nutrient limitation
+   INTEGER  ::  jliebig   !:  Liebig nutrient uptake switch
+   REAL(wp) ::  xnln      !:  half-sat constant for DIN uptake by non-diatoms 
+   REAL(wp) ::  xnld      !:  half-sat constant for DIN uptake by diatoms 
+   REAL(wp) ::  xsld      !:  half-sat constant for Si uptake by diatoms 
+   REAL(wp) ::  xfln      !:  half-sat constant for Fe uptake by non-diatoms 
+   REAL(wp) ::  xfld      !:  half-sat constant for Fe uptake by diatoms  
+!!
+!! Grazing
+   REAL(wp) ::  xgmi      !:  microzoo maximum growth rate 
+   REAL(wp) ::  xgme      !:  mesozoo maximum growth rate 
+   REAL(wp) ::  xkmi      !:  microzoo grazing half-sat parameter
+   REAL(wp) ::  xkme      !:  mesozoo grazing half-sat parameter
+   REAL(wp) ::  xphi      !:  micro/mesozoo grazing inefficiency
+   REAL(wp) ::  xbetan    !:  micro/mesozoo N assimilation efficiency
+   REAL(wp) ::  xbetac    !:  micro/mesozoo C assimilation efficiency
+   REAL(wp) ::  xkc       !:  micro/mesozoo net C growth efficiency
+   REAL(wp) ::  xpmipn    !:  grazing preference of microzoo for non-diatoms
+   REAL(wp) ::  xpmid     !:  grazing preference of microzoo for diatoms
+   REAL(wp) ::  xpmepn    !:  grazing preference of mesozoo for non-diatoms 
+   REAL(wp) ::  xpmepd    !:  grazing preference of mesozoo for diatoms
+   REAL(wp) ::  xpmezmi   !:  grazing preference of mesozoo for microzoo
+   REAL(wp) ::  xpmed     !:  grazing preference of mesozoo for detritus
+!!
+!! Metabolic losses
+   REAL(wp) ::  xmetapn   !:  non-diatom metabolic loss rate
+   REAL(wp) ::  xmetapd   !:  diatom     metabolic loss rate
+   REAL(wp) ::  xmetazmi  !:  microzoo   metabolic loss rate
+   REAL(wp) ::  xmetazme  !:  mesozoo    metabolic loss rate
+!!
+!! Mortality losses
+   INTEGER  ::  jmpn      !:  non-diatom mortality functional form
+   REAL(wp) ::  xmpn      !:  non-diatom mortality rate
+   REAL(wp) ::  xkphn     !:  non-diatom mortality half-sat constant
+   INTEGER  ::  jmpd      !:  diatom     mortality functional form
+   REAL(wp) ::  xmpd      !:  diatom     mortality rate
+   REAL(wp) ::  xkphd     !:  diatom     mortality half-sat constant
+   INTEGER  ::  jmzmi     !:  microzoo   mortality functional form
+   REAL(wp) ::  xmzmi     !:  microzoo   mortality rate
+   REAL(wp) ::  xkzmi     !:  microzoo   mortality half-sat constant
+   INTEGER  ::  jmzme     !:  mesozoo    mortality functional form
+   REAL(wp) ::  xmzme     !:  mesozoo    mortality rate
+   REAL(wp) ::  xkzme     !:  mesozoo    mortality half-sat constant
+!!
+!! Remineralisation
+   INTEGER  ::  jmd       !:  detritus T-dependent remineralisation switch
+   INTEGER  ::  jsfd      !:  accelerate seafloor detritus remin. switch
+   REAL(wp) ::  xmd       !:  detrital nitrogen remineralisation rate 
+   REAL(wp) ::  xmdc      !:  detrital carbon remineralisation rate 
+!!
+!! Stochiometric ratios
+   REAL(wp) ::  xthetapn  !:  non-diatom C:N ratio
+   REAL(wp) ::  xthetapd  !:  diatom C:N ratio
+   REAL(wp) ::  xthetazmi !:  microzoo C:N ratio
+   REAL(wp) ::  xthetazme !:  mesozoo C:N ratio
+   REAL(wp) ::  xthetad   !:  detritus C:N ratio
+   REAL(wp) ::  xrfn      !:  phytoplankton Fe:N ratio
+   REAL(wp) ::  xrsn      !:  diatom Si:N ratio (NOT USED HERE; RETAINED FOR LOBSTER)
+!!
+!! Iron parameters
+   INTEGER  ::  jiron     !:  iron scavenging submodel switch
+   REAL(wp) ::  xfe_mass  !:  iron atomic mass
+   REAL(wp) ::  xfe_sol   !:  aeolian iron solubility
+   REAL(wp) ::  xfe_sed   !:  sediment iron input
+   REAL(wp) ::  xLgT      !:  total ligand concentration (umol/m3)
+   REAL(wp) ::  xk_FeL    !:  dissociation constant for (Fe + L)
+   REAL(wp) ::  xk_sc_Fe  !:  scavenging rate of "free" iron
+!!
+!! Gravitational sinking      
+   REAL(wp) ::  vsed      !:  detritus gravitational sinking rate 
+   REAL(wp) ::  xhr       !:  coefficient for Martin et al. (1987) remineralisation
+!!
+!! Fast-sinking detritus parameters
+   INTEGER  ::  jexport   !:  fast detritus remineralisation switch
+   INTEGER  ::  jfdfate   !:  fate of fast detritus at seafloor switch
+   INTEGER  ::  jrratio   !:  rain ratio switch
+   INTEGER  ::  jocalccd  !:  CCD switch
+   REAL(wp) ::  xridg_r0  !:  Ridgwell rain ratio coefficient
+   REAL(wp) ::  xfdfrac1  !:  fast-sinking fraction of diatom nat. mort. losses
+   REAL(wp) ::  xfdfrac2  !:  fast-sinking fraction of mesozooplankton mort. losses
+   REAL(wp) ::  xfdfrac3  !:  fast-sinking fraction of diatom silicon grazing losses
+   REAL(wp) ::  xcaco3a   !:  polar (high latitude) CaCO3 fraction
+   REAL(wp) ::  xcaco3b   !:  equatorial (low latitude) CaCO3 fraction
+   REAL(wp) ::  xmassc    !:  organic C mass:mole ratio, C106 H175 O40 N16 P1
+   REAL(wp) ::  xmassca   !:  calcium carbonate mass:mole ratio, CaCO3
+   REAL(wp) ::  xmasssi   !:  biogenic silicon mass:mole ratio, (H2SiO3)n
+   REAL(wp) ::  xprotca   !:  calcium carbonate protection ratio
+   REAL(wp) ::  xprotsi   !:  biogenic silicon protection ratio
+   REAL(wp) ::  xfastc    !:  organic C remineralisation length scale
+   REAL(wp) ::  xfastca   !:  calcium carbonate dissolution length scale
+   REAL(wp) ::  xfastsi   !:  biogenic silicon dissolution length scale
+!!
+!! Benthos parameters
+   INTEGER  ::  jorgben   !:  does   organic detritus go to the benthos?
+   INTEGER  ::  jinorgben !:  does inorganic detritus go to the benthos?
+!!
+   REAL(wp) ::  xsedn     !:  organic   nitrogen sediment remineralisation rate 
+   REAL(wp) ::  xsedfe    !:  organic   iron     sediment remineralisation rate 
+   REAL(wp) ::  xsedsi    !:  inorganic silicon  sediment dissolution      rate 
+   REAL(wp) ::  xsedc     !:  organic   carbon   sediment remineralisation rate 
+   REAL(wp) ::  xsedca    !:  inorganic carbon   sediment dissolution      rate 
+   REAL(wp) ::  xburial   !:  burial rate of seafloor detritus
+!!
+!! River parameters
+   INTEGER  ::  jriver_n  !:  riverine nitrogen?   0 = no, 1 = conc, 2 = flux
+   INTEGER  ::  jriver_si !:  riverine silicon?    0 = no, 1 = conc, 2 = flux
+   INTEGER  ::  jriver_c  !:  riverine carbon?     0 = no, 1 = conc, 2 = flux
+   INTEGER  ::  jriver_alk!:  riverine alkalinity? 0 = no, 1 = conc, 2 = flux
+   INTEGER  ::  jriver_dep!:  depth river input added to?  1 = surface, >1 possible
+!!
+!! Miscellaneous
+   REAL(wp) ::  xsdiss    !:  diatom frustule dissolution rate
+!!
+!! Additional parameters
+   INTEGER  ::  jpkb      !:  vertical layer for diagnostic of the vertical flux 
+!!
+!! UKESM diagnostics
+   INTEGER  ::  jdms         !: include DMS diagnostics ? Jpalm (27-08-2014) 
+   INTEGER  ::  jdms_input   !: use instant (0) or diel-average (1) inputs (AXY, 08/07/2015)
+   INTEGER  ::  jdms_model   !: choice of DMS model passed to atmosphere
+!!                              1 = ANDR, 2 = SIMO, 3 = ARAN, 4 = HALL
+!!
+!!
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   remdmp   !: depth dependent damping coefficient of passive tracers 
+!!
+!! AXY (27/07/10): add in indices for depth horizons (for sinking flux
+!!                 and seafloor iron inputs)
+   INTEGER  ::    i0100, i0150, i0200, i0500, i1000, i1100
+#if defined key_roam
+!!
+!! ROAM carbon, alkalinity and oxygen cycle parameters
+   REAL(wp) ::  xthetaphy    !:  oxygen evolution/consumption by phytoplankton 
+   REAL(wp) ::  xthetazoo    !:  oxygen consumption by zooplankton 
+   REAL(wp) ::  xthetanit    !:  oxygen consumption by nitrogen remineralisation
+   REAL(wp) ::  xthetarem    !:  oxygen consumption by carbon remineralisation
+   REAL(wp) ::  xo2min       !:  oxygen minimum concentration
+!! 
+!! 3D fields of carbonate system parameters
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: f3_pH       !: 3D pH
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: f3_h2co3    !: 3D carbonic acid
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: f3_hco3     !: 3D bicarbonate
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: f3_co3      !: 3D carbonate
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: f3_omcal    !: 3D omega calcite
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: f3_omarg    !: 3D omega aragonite
+!! 
+!! 2D fields of calcium carbonate compensation depth
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: f2_ccd_cal  !: 2D calcite CCD depth
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: f2_ccd_arg  !: 2D aragonite CCD depth
+!!
+!! 2D fields of organic and inorganic material sedimented on the seafloor
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zb_sed_n    !: 2D organic nitrogen   (before)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zn_sed_n    !: 2D organic nitrogen   (now)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: za_sed_n    !: 2D organic nitrogen   (after)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zb_sed_fe   !: 2D organic iron       (before)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zn_sed_fe   !: 2D organic iron       (now)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: za_sed_fe   !: 2D organic iron       (after)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zb_sed_si   !: 2D inorganic silicon  (before)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zn_sed_si   !: 2D inorganic silicon  (now)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: za_sed_si   !: 2D inorganic silicon  (after)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zb_sed_c    !: 2D organic carbon     (before)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zn_sed_c    !: 2D organic carbon     (now)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: za_sed_c    !: 2D organic carbon     (after)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zb_sed_ca   !: 2D inorganic carbon   (before)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zn_sed_ca   !: 2D inorganic carbon   (now)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: za_sed_ca   !: 2D inorganic carbon   (after)
+!!
+!! 2D fields of temporally averaged properties for DMS calculations (AXY, 07/07/15)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zb_dms_chn  !: 2D avg CHN   (before)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zn_dms_chn  !: 2D avg CHN   (now)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: za_dms_chn  !: 2D avg CHN   (after)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zb_dms_chd  !: 2D avg CHD   (before)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zn_dms_chd  !: 2D avg CHD   (now)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: za_dms_chd  !: 2D avg CHD   (after)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zb_dms_mld  !: 2D avg MLD   (before)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zn_dms_mld  !: 2D avg MLD   (now)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: za_dms_mld  !: 2D avg MLD   (after)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zb_dms_qsr  !: 2D avg QSR   (before)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zn_dms_qsr  !: 2D avg QSR   (now)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: za_dms_qsr  !: 2D avg QSR   (after)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zb_dms_din  !: 2D avg DIN   (before)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zn_dms_din  !: 2D avg DIN   (now)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: za_dms_din  !: 2D avg DIN   (after)
+!!
+!! 2D fields needing to be knows at first tstp for coupling with atm - UKEMS(Jpalm,14-06-2016)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zb_co2_flx  !: 2D avg fx co2 (before)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zn_co2_flx  !: 2D avg fx co2 (now)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: za_co2_flx  !: 2D avg fx co2 (after)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zb_dms_srf  !: 2D avg sfr dms (before)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zn_dms_srf  !: 2D avg sfr dms (now)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: za_dms_srf  !: 2D avg srf dms (after)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zn_chl_srf  !: 2D avg srf chl (now)
+
+#endif
+
+!!----------------------------------------------------------------------
+!! CCD parameter
+!!----------------------------------------------------------------------
+!!
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ocal_ccd  !: CCD depth
+
+!!----------------------------------------------------------------------
+!! Dust parameters
+!!----------------------------------------------------------------------
+!!
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   dust      !: dust parameter 1
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   zirondep  !! Fe deposition
+
+!!----------------------------------------------------------------------
+!! River parameters
+!!----------------------------------------------------------------------
+!!
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   riv_n      !: riverine N
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   riv_si     !: riverine Si
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   riv_c      !: riverine C
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   riv_alk    !: riverine alkalinity
+   !! AXY (19/07/12): add this to permit river fluxes to be added below top box
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   friver_dep !: where river fluxes added
+
+#if defined key_roam
+!!----------------------------------------------------------------------
+!! Atmospheric pCO2 data (1859 to 2100 inclusive)
+!!----------------------------------------------------------------------
+!!
+   REAL(wp), DIMENSION(242)         ::   hist_pco2 !: pCO2
+
+# if defined key_rcp26
+      !! UKMO, run AJKKH + KAAEC, RCP 2.6, pCO2 time evolution
+      DATA hist_pco2 / 286.0230, 286.1730, 286.3230, 286.4480, 286.5730, &
+      & 286.7230, 286.8480, 286.9480, 287.0480, 287.1730, &
+      & 287.3230, 287.4730, 287.6480, 287.8480, 288.0730, &
+      & 288.3480, 288.6480, 288.9730, 289.3470, 289.7470, &
+      & 290.1730, 290.6470, 291.1470, 291.6220, 292.0720, &
+      & 292.5220, 292.9220, 293.2470, 293.5220, 293.7470, &
+      & 293.9470, 294.1220, 294.2720, 294.4220, 294.5470, &
+      & 294.6470, 294.7470, 294.8470, 294.9710, 295.1710, &
+      & 295.4460, 295.7470, 296.0720, 296.4210, 296.7710, &
+      & 297.1460, 297.5710, 298.0210, 298.4460, 298.8460, &
+      & 299.2460, 299.6450, 300.0210, 300.3710, 300.7200, &
+      & 301.0450, 301.3460, 301.6710, 302.0200, 302.3450, &
+      & 302.6450, 302.9700, 303.3450, 303.7200, 304.0700, &
+      & 304.4700, 304.9200, 305.3440, 305.7700, 306.2450, &
+      & 306.7190, 307.1700, 307.6440, 308.1190, 308.5440, &
+      & 308.9440, 309.3440, 309.6940, 309.9440, 310.1190, &
+      & 310.2440, 310.3190, 310.3190, 310.2440, 310.1440, &
+      & 310.0690, 310.0440, 310.0690, 310.1440, 310.2690, &
+      & 310.4440, 310.6940, 311.0430, 311.4440, 311.8690, &
+      & 312.3680, 312.9430, 313.5430, 314.1680, 314.7900, &
+      & 315.4430, 316.2150, 317.0170, 317.7370, 318.3400, &
+      & 318.8680, 319.5900, 320.5890, 321.5470, 322.5770, &
+      & 323.8440, 324.9260, 325.7960, 327.0810, 328.6180, &
+      & 329.6830, 330.5250, 331.6880, 333.2120, 334.7870, &
+      & 336.4640, 338.2990, 339.6660, 340.7310, 342.1360, &
+      & 343.7200, 345.2200, 346.7350, 348.5820, 350.6740, &
+      & 352.4230, 353.7910, 354.9530, 355.8210, 356.7130, &
+      & 358.0630, 359.7720, 361.3970, 363.0900, 365.2560, &
+      & 367.2810, 368.7980, 370.4000, 372.4550, 374.6920, &
+      & 376.7440, 378.7440, 380.7580, 382.7080, 384.7300, &
+      & 386.9310, 389.2150, 391.4910, 393.7710, 396.0460, &
+      & 398.3240, 400.6080, 402.8950, 405.1780, 407.4550, &
+      & 409.7260, 411.9930, 414.2500, 416.4410, 418.5280, &
+      & 420.5250, 422.4390, 424.2720, 426.0200, 427.6750, &
+      & 429.2360, 430.7050, 432.0850, 433.3580, 434.5140, &
+      & 435.5740, 436.5490, 437.4420, 438.2550, 438.9810, &
+      & 439.6110, 440.1430, 440.5770, 440.9450, 441.2660, &
+      & 441.5410, 441.7840, 442.0050, 442.2040, 442.3780, &
+      & 442.5210, 442.6200, 442.6720, 442.6810, 442.6540, &
+      & 442.5830, 442.4670, 442.3270, 442.1680, 441.9960, &
+      & 441.8060, 441.5930, 441.3440, 441.0540, 440.7230, &
+      & 440.3510, 439.9300, 439.4650, 438.9730, 438.4630, &
+      & 437.9400, 437.4020, 436.8400, 436.2640, 435.6850, &
+      & 435.1030, 434.5160, 433.9170, 433.3060, 432.7010, &
+      & 432.1110, 431.5380, 430.9810, 430.4320, 429.8860, &
+      & 429.3370, 428.7810, 428.2220, 427.6490, 427.0660, &
+      & 426.4890, 425.9270, 425.3840, 424.8610, 424.3540, &
+      & 423.8540, 423.3540, 422.8530, 422.3510, 421.8410, &
+      & 421.3250, 420.8190 /
+# else
+      !! UKMO, run AJKKH + KAAEF, RCP 8.5, pCO2 time evolution
+      DATA hist_pco2 / 286.0230, 286.1730, 286.3230, 286.4480, 286.5730, &
+      & 286.7230, 286.8480, 286.9480, 287.0480, 287.1730, &
+      & 287.3230, 287.4730, 287.6480, 287.8480, 288.0730, &
+      & 288.3480, 288.6480, 288.9730, 289.3470, 289.7470, &
+      & 290.1730, 290.6470, 291.1470, 291.6220, 292.0720, &
+      & 292.5220, 292.9220, 293.2470, 293.5220, 293.7470, &
+      & 293.9470, 294.1220, 294.2720, 294.4220, 294.5470, &
+      & 294.6470, 294.7470, 294.8470, 294.9710, 295.1710, &
+      & 295.4460, 295.7470, 296.0720, 296.4210, 296.7710, &
+      & 297.1460, 297.5710, 298.0210, 298.4460, 298.8460, &
+      & 299.2460, 299.6450, 300.0210, 300.3710, 300.7200, &
+      & 301.0450, 301.3460, 301.6710, 302.0200, 302.3450, &
+      & 302.6450, 302.9700, 303.3450, 303.7200, 304.0700, &
+      & 304.4700, 304.9200, 305.3440, 305.7700, 306.2450, &
+      & 306.7190, 307.1700, 307.6440, 308.1190, 308.5440, &
+      & 308.9440, 309.3440, 309.6940, 309.9440, 310.1190, &
+      & 310.2440, 310.3190, 310.3190, 310.2440, 310.1440, &
+      & 310.0690, 310.0440, 310.0690, 310.1440, 310.2690, &
+      & 310.4440, 310.6940, 311.0430, 311.4440, 311.8690, &
+      & 312.3680, 312.9430, 313.5430, 314.1680, 314.7900, &
+      & 315.4430, 316.2150, 317.0170, 317.7370, 318.3400, &
+      & 318.8680, 319.5900, 320.5890, 321.5470, 322.5770, &
+      & 323.8440, 324.9260, 325.7960, 327.0810, 328.6180, &
+      & 329.6830, 330.5250, 331.6880, 333.2120, 334.7870, &
+      & 336.4640, 338.2990, 339.6660, 340.7310, 342.1360, &
+      & 343.7200, 345.2200, 346.7350, 348.5820, 350.6740, &
+      & 352.4230, 353.7910, 354.9530, 355.8210, 356.7130, &
+      & 358.0630, 359.7720, 361.3970, 363.0900, 365.2560, &
+      & 367.2810, 368.7980, 370.4000, 372.4550, 374.6920, &
+      & 376.7440, 378.7440, 380.7580, 382.7080, 384.7300, &
+      & 386.9420, 389.2540, 391.5670, 393.9370, 396.3920, &
+      & 398.9320, 401.5550, 404.2550, 407.0220, 409.8530, &
+      & 412.7470, 415.7050, 418.7210, 421.7880, 424.9180, &
+      & 428.1200, 431.3970, 434.7470, 438.1650, 441.6410, &
+      & 445.1700, 448.7530, 452.3920, 456.0950, 459.8810, &
+      & 463.7680, 467.7660, 471.8750, 476.0960, 480.4210, &
+      & 484.8390, 489.3470, 493.9430, 498.6400, 503.4380, &
+      & 508.3410, 513.3630, 518.5160, 523.8050, 529.2290, &
+      & 534.7780, 540.4450, 546.2230, 552.1120, 558.1110, &
+      & 564.2110, 570.4130, 576.7390, 583.1990, 589.7980, &
+      & 596.5390, 603.4110, 610.4060, 617.4940, 624.6500, &
+      & 631.8800, 639.1750, 646.5360, 653.9800, 661.5230, &
+      & 669.1840, 676.9570, 684.8290, 692.7790, 700.7690, &
+      & 708.8050, 716.8870, 725.0020, 733.1770, 741.3900, &
+      & 749.6700, 758.0480, 766.5050, 775.0350, 783.6110, &
+      & 792.2200, 800.8740, 809.5680, 818.2760, 827.0090, &
+      & 835.8020, 844.6550, 853.5730, 862.5690, 871.6190, &
+      & 880.7020, 889.8240, 898.9590, 908.1270, 917.3080, &
+      & 926.4960, 935.7040 /
+# endif
+#endif
+
+!!----------------------------------------------------------------------
+!! Optical parameters
+!!----------------------------------------------------------------------
+!!
+   REAL(wp) ::   xkr0       !: water coefficient absorption in red      (NAMELIST)
+   REAL(wp) ::   xkg0       !: water coefficient absorption in green    (NAMELIST)
+   REAL(wp) ::   xkrp       !: pigment coefficient absorption in red    (NAMELIST)
+   REAL(wp) ::   xkgp       !: pigment coefficient absorption in green  (NAMELIST)
+   REAL(wp) ::   xlr        !: exposant for pigment absorption in red   (NAMELIST)
+   REAL(wp) ::   xlg        !: exposant for pigment absorption in green (NAMELIST)
+   REAL(wp) ::   rpig       !: chla/chla+phea ratio                     (NAMELIST)
+                                                        
+   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   neln    !: number of levels in the euphotic layer
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   xze     !: euphotic layer depth
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xpar    !: par (photosynthetic available radiation)
+
+!!----------------------------------------------------------------------
+!! Sediment parameters                               
+!! 
+!! AXY (16/01/12): these parameters were originally part of the pre-
+!!                 cursor model on which MEDUSA's code was grounded;
+!!                 they do not relate to the sediment/benthos submodel
+!!                 added as part of the ROAM project; they have only
+!!                 been retained because they are distributed through
+!!                 MEDUSA and require a proper clean-up to purge
+!!----------------------------------------------------------------------
+!!
+   REAL(wp) ::   sedlam       !: time coefficient of POC remineralization in sediments
+   REAL(wp) ::   sedlostpoc   !: ???
+   REAL(wp) ::   areacot      !: ???
+                                                        
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: dminl       !: fraction of sinking POC released in sediments
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dmin3       !: fraction of sinking POC released at each level
+                                                        
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: sedpocb     !: mass of POC in sediments
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: sedpocn     !: mass of POC in sediments
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: sedpoca     !: mass of POC in sediments
+                                                        
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: fbodf       !: rapid sinking particles
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: fbods       !: rapid sinking particles
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: fbodn       !: rapid sinking particles
+                                                        
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ffln        !: 
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: fflf        !: 
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ffls        !: 
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: cmask       !: ???
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION sms_medusa_alloc()
+      !!----------------------------------------------------------------------
+      !!        *** ROUTINE sms_medusa_alloc ***
+      !!----------------------------------------------------------------------
+      USE lib_mpp , ONLY: ctl_warn
+      INTEGER ::   ierr(8)        ! Local variables
+      !!----------------------------------------------------------------------
+      ierr(:) = 0
+      !
+#if defined key_medusa
+      !* depth-dependent damping coefficient
+      ALLOCATE( remdmp(jpk,jp_medusa),                           STAT=ierr(1) )
+# if defined key_roam
+      !* 2D and 3D fields of carbonate system parameters
+      ALLOCATE( f2_ccd_cal(jpi,jpj)  , f2_ccd_arg(jpi,jpj)  ,       &
+         &      f3_pH(jpi,jpj,jpk)   , f3_h2co3(jpi,jpj,jpk),       &
+         &      f3_hco3(jpi,jpj,jpk) , f3_co3(jpi,jpj,jpk)  ,       &
+         &      f3_omcal(jpi,jpj,jpk), f3_omarg(jpi,jpj,jpk),    STAT=ierr(2) )
+      !* 2D fields of organic and inorganic material sedimented on the seafloor
+      ALLOCATE( zb_sed_n(jpi,jpj)    , zn_sed_n(jpi,jpj)    ,       &
+         &      za_sed_n(jpi,jpj)    ,                              &
+         &      zb_sed_fe(jpi,jpj)   , zn_sed_fe(jpi,jpj)   ,       &
+         &      za_sed_fe(jpi,jpj)   ,                              &
+         &      zb_sed_si(jpi,jpj)   , zn_sed_si(jpi,jpj)   ,       &
+         &      za_sed_si(jpi,jpj)   ,                              &
+         &      zb_sed_c(jpi,jpj)    , zn_sed_c(jpi,jpj)    ,       &
+         &      za_sed_c(jpi,jpj)    ,                              &
+         &      zb_sed_ca(jpi,jpj)   , zn_sed_ca(jpi,jpj)   ,       &
+         &      za_sed_ca(jpi,jpj)   ,                           STAT=ierr(3) )
+      !* 2D fields of temporally averaged properties for DMS calculations (AXY, 07/07/15)
+      ALLOCATE( zb_dms_chn(jpi,jpj)  , zn_dms_chn(jpi,jpj)  ,       &
+         &      za_dms_chn(jpi,jpj)  ,                              &
+         &      zb_dms_chd(jpi,jpj)  , zn_dms_chd(jpi,jpj)  ,       &		  
+         &      za_dms_chd(jpi,jpj)  ,                              &
+         &      zb_dms_mld(jpi,jpj)  , zn_dms_mld(jpi,jpj)  ,       &		  
+         &      za_dms_mld(jpi,jpj)  ,                              &
+         &      zb_dms_qsr(jpi,jpj)  , zn_dms_qsr(jpi,jpj)  ,       &		  
+         &      za_dms_qsr(jpi,jpj)  ,                              &
+         &      zb_dms_din(jpi,jpj)  , zn_dms_din(jpi,jpj)  ,       &		  
+         &      za_dms_din(jpi,jpj)  ,                           STAT=ierr(4) )
+      !* 2D fields needing to be knows at first tstp for coupling with atm -
+      !UKEMSi (Jpalm,14-06-2016) 
+      ALLOCATE( zb_co2_flx(jpi,jpj)  , zn_co2_flx(jpi,jpj)  ,       &
+         &      za_co2_flx(jpi,jpj)  ,                              &
+         &      zb_dms_srf(jpi,jpj)  , zn_dms_srf(jpi,jpj)  ,       &           
+         &      za_dms_srf(jpi,jpj)  , zn_chl_srf(jpi,jpj)  ,    STAT=ierr(5) )
+# endif
+      !* 2D fields of miscellaneous parameters
+      ALLOCATE( ocal_ccd(jpi,jpj)    , dust(jpi,jpj)        ,       &
+         &      zirondep(jpi,jpj)                           ,       &
+         &      riv_n(jpi,jpj)                              ,       &
+         &      riv_si(jpi,jpj)      , riv_c(jpi,jpj)       ,       &
+         &      riv_alk(jpi,jpj)     , friver_dep(jpk,jpk)  ,    STAT=ierr(6) )
+      !* 2D and 3D fields of light parameters
+      ALLOCATE( neln(jpi,jpj)        , xze(jpi,jpj)         ,       &
+         &      xpar(jpi,jpj,jpk)    ,                           STAT=ierr(7) )
+      !* 2D and 3D fields of sediment-associated parameters
+      ALLOCATE( dminl(jpi,jpj)       , dmin3(jpi,jpj,jpk)   ,       &
+         &      sedpocb(jpi,jpj)     , sedpocn(jpi,jpj)     ,       &
+         &      sedpoca(jpi,jpj)     , fbodn(jpi,jpj)       ,       &
+         &      fbodf(jpi,jpj)       , fbods(jpi,jpj)       ,       &
+         &      ffln(jpi,jpj,jpk)    , fflf(jpi,jpj,jpk)    ,       &
+         &      ffls(jpi,jpj,jpk)    , cmask(jpi,jpj)       ,    STAT=ierr(8) ) 
+#endif
+      !
+      sms_medusa_alloc = MAXVAL( ierr )
+      !
+      IF( sms_medusa_alloc /= 0 )   CALL ctl_warn('sms_medusa_alloc: failed to allocate arrays')
+      !
+   END FUNCTION sms_medusa_alloc
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Empty module :                                     NO MEDUSA model 
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE sms_medusa
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcavg_medusa.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcavg_medusa.F90	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcavg_medusa.F90	(revision 8201)
@@ -0,0 +1,128 @@
+MODULE trcavg_medusa
+   !!======================================================================
+   !!                         ***  MODULE trcavg_medusa  ***
+   !! TOP :   MEDUSA
+   !!======================================================================
+   !! History :    -   !  2015-07  (A. Yool) Original code
+   !!----------------------------------------------------------------------
+#if defined key_medusa && defined key_roam
+   !!----------------------------------------------------------------------
+   !!                                        MEDUSA rolling averages
+   !!----------------------------------------------------------------------
+   !!   trc_avg_medusa        :  
+   !!----------------------------------------------------------------------
+      USE oce_trc
+      USE trc
+      USE sms_medusa
+      USE lbclnk
+      USE prtctl_trc      ! Print control for debugging
+      USE in_out_manager  ! I/O manager
+
+      IMPLICIT NONE
+      PRIVATE
+
+      PUBLIC   trc_avg_medusa    ! called in trc_sms_medusa
+
+   !!* Substitution
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+!=======================================================================
+!
+      SUBROUTINE trc_avg_medusa( kt )
+!      
+!=======================================================================
+      !!
+      !! Title  : Calculates rolling averages of variables
+      !! Author : Andrew Yool
+      !! Date   : 23/07/15
+      !!
+      !! Calculates and updates rolling averages of properties such
+      !! as surface irradiance and mixed layer depth that are used
+      !! in functions that require average rather than instantaneous
+      !! values.
+      !!
+      !! This functionality was originally added to support the
+      !! calculation of surface DMS concentrations - and was done so
+      !! within the trcbio_meduse.F90 routine - but was moved to
+      !! this separate module so that its calculations could be used
+      !! to inform MEDUSA's submarine irradiance field
+      !!
+!=======================================================================
+!
+      IMPLICIT NONE
+!
+      INTEGER, INTENT( in ) ::   kt   ! index of the time stepping
+! 
+!=======================================================================
+# if defined key_debug_medusa
+         IF(lwp) WRITE(numout,*) ' MEDUSA inside trc_avg_medusa'
+         CALL flush(numout)
+# endif
+      !! AXY (24/07/15): alter this to report on first MEDUSA call
+      IF( kt == nittrc000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' trc_avg_medusa: MEDUSA rolling average'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~'
+         IF(lwp) WRITE(numout,*) ' kt =',kt
+      ENDIF
+      !!
+      !!----------------------------------------------------------------------
+      !! Process average fields
+      !! The empirical formulae used for estimating surface DMS concentrations
+      !! require temporally averaged input fields; this block calculates these
+      !! averages based on diel averages; note that rdt 
+      !!----------------------------------------------------------------------
+      !!
+      zn_dms_chn(:,:) = ( zb_dms_chn(:,:) * ((86400. - rdt) / 86400.) ) &
+      &                  + ( trn(:,:,1,jpchn) * (rdt / 86400.) )
+      zb_dms_chn(:,:) = zn_dms_chn(:,:)
+      zn_dms_chd(:,:) = ( zb_dms_chd(:,:) * ((86400. - rdt) / 86400.) ) &
+      &                  + ( trn(:,:,1,jpchd) * (rdt / 86400.) )
+      zb_dms_chd(:,:) = zn_dms_chd(:,:)
+      zn_dms_mld(:,:) = ( zb_dms_mld(:,:) * ((86400. - rdt) / 86400.) ) &
+      &                  + (        hmld(:,:) * (rdt / 86400.) )
+      zb_dms_mld(:,:) = zn_dms_mld(:,:)
+      zn_dms_qsr(:,:) = ( zb_dms_qsr(:,:) * ((86400. - rdt) / 86400.) ) &
+      &                  + (         qsr(:,:) * (rdt / 86400.) )
+      zb_dms_qsr(:,:) = zn_dms_qsr(:,:)
+      zn_dms_din(:,:) = ( zb_dms_din(:,:) * ((86400. - rdt) / 86400.) ) &
+      &                  + ( trn(:,:,1,jpdin) * (rdt / 86400.) )
+      zb_dms_din(:,:) = zn_dms_din(:,:)
+
+  END SUBROUTINE trc_avg_medusa
+
+!=======================================================================
+!=======================================================================
+!=======================================================================
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No MEDUSA bio-model
+   !!======================================================================
+
+CONTAINS
+
+!=======================================================================
+!
+   SUBROUTINE trc_avg_medusa( kt )                                        !! EMPTY Routine
+!      
+!
+      INTEGER, INTENT( in ) ::   kt
+!
+
+      WRITE(*,*) 'trc_avg_medusa: You should not have seen this print! error?'
+
+   END SUBROUTINE trc_avg_medusa
+#endif
+
+   !!======================================================================
+END MODULE  trcavg_medusa
+
+
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcbio_medusa.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcbio_medusa.F90	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcbio_medusa.F90	(revision 8201)
@@ -0,0 +1,6198 @@
+MODULE trcbio_medusa
+   !!======================================================================
+   !!                         ***  MODULE trcbio  ***
+   !! TOP :   MEDUSA
+   !!======================================================================
+   !! History :
+   !!  -   !  1999-07  (M. Levy)              original code
+   !!  -   !  2000-12  (E. Kestenare)         assign parameters to name individual tracers
+   !!  -   !  2001-03  (M. Levy)              LNO3 + dia2d 
+   !! 2.0  !  2007-12  (C. Deltel, G. Madec)  F90
+   !!  -   !  2008-08  (K. Popova)            adaptation for MEDUSA
+   !!  -   !  2008-11  (A. Yool)              continuing adaptation for MEDUSA
+   !!  -   !  2010-03  (A. Yool)              updated for branch inclusion
+   !!  -   !  2011-08  (A. Yool)              updated for ROAM (see below)
+   !!  -   !  2013-03  (A. Yool)              updated for iMARNET
+   !!  -   !  2013-05  (A. Yool)              updated for v3.5
+   !!  -   !  2014-08  (A. Yool, J. Palm)     Add DMS module for UKESM1 model
+   !!  -   !  2015-06  (A. Yool)              Update to include MOCSY
+   !!  -   !  2015-07  (A. Yool)              Update for rolling averages
+   !!  -   !  2015-10  (J. Palm)              Update for diag outputs through iom_use  
+   !!  -   !  2016-11  (A. Yool)              Updated diags for CMIP6
+   !!  -   !  2017-05  (A. Yool)              Added extra DMS calculation
+   !!----------------------------------------------------------------------
+   !!
+#if defined key_roam
+   !!----------------------------------------------------------------------
+   !! Updates for the ROAM project include:
+   !!   - addition of DIC, alkalinity, detrital carbon and oxygen tracers
+   !!   - addition of air-sea fluxes of CO2 and oxygen
+   !!   - periodic (monthly) calculation of full 3D carbonate chemistry 
+   !!   - detrital C:N ratio now free to evolve dynamically
+   !!   - benthic storage pools
+   !! 
+   !! Opportunity also taken to add functionality:
+   !!   - switch for Liebig Law (= most-limiting) nutrient uptake
+   !!   - switch for accelerated seafloor detritus remineralisation
+   !!   - switch for fast -> slow detritus transfer at seafloor
+   !!   - switch for ballast vs. Martin vs. Henson fast detritus remin.
+   !!   - per GMD referee remarks, xfdfrac3 introduced for grazed PDS
+   !!----------------------------------------------------------------------
+#endif
+   !!
+#if defined key_mocsy
+   !!----------------------------------------------------------------------
+   !! Updates with the addition of MOCSY include:
+   !!   - option to use PML or MOCSY carbonate chemistry (the latter is 
+   !!     preferred)
+   !!   - central calculation of gas transfer velocity, f_kw660; previously
+   !!     this was done separately for CO2 and O2 with predictable results
+   !!   - distribution of f_kw660 to both PML and MOCSY CO2 air-sea flux 
+   !!     calculations and to those for O2 air-sea flux
+   !!   - extra diagnostics included for MOCSY
+   !!----------------------------------------------------------------------
+#endif
+   !!
+#if defined key_medusa
+   !!----------------------------------------------------------------------
+   !!                                        MEDUSA bio-model
+   !!----------------------------------------------------------------------
+   !!   trc_bio_medusa        :  
+   !!----------------------------------------------------------------------
+      USE oce_trc
+      USE trc
+      USE sms_medusa
+      USE lbclnk
+      USE prtctl_trc      ! Print control for debugging
+      USE trcsed_medusa
+      USE sbc_oce         ! surface forcing
+      USE sbcrnf          ! surface boundary condition: runoff variables
+      USE in_out_manager  ! I/O manager
+# if defined key_iomput
+      USE iom
+      USE trcnam_medusa         ! JPALM 13-11-2015 -- if iom_use for diag
+      !!USE trc_nam_iom_medusa  ! JPALM 13-11-2015 -- if iom_use for diag
+# endif
+# if defined key_roam
+      USE gastransfer
+#  if defined key_mocsy
+      USE mocsy_wrapper
+#  else
+      USE trcco2_medusa
+#  endif
+      USE trcoxy_medusa
+      !! Jpalm (08/08/2014)
+      USE trcdms_medusa
+# endif
+      !! AXY (18/01/12): brought in for benthic timestepping
+      USE trcnam_trp      ! AXY (24/05/2013)
+      USE trdmxl_trc
+      USE trdtrc_oce  ! AXY (24/05/2013)
+
+      !! AXY (30/01/14): necessary to find NaNs on HECTOR
+      USE, INTRINSIC :: ieee_arithmetic 
+
+      !! JPALM (27-06-2016): add lk_oasis for CO2 and DMS coupling with atm
+      USE sbc_oce, ONLY: lk_oasis
+      USE oce,     ONLY: CO2Flux_out_cpl, DMS_out_cpl, PCO2a_in_cpl, chloro_out_cpl
+
+      IMPLICIT NONE
+      PRIVATE
+      
+      PUBLIC   trc_bio_medusa    ! called in ???
+
+   !!* Substitution
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_bio_medusa( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_bio  ***
+      !!
+      !! ** Purpose :   compute the now trend due to biogeochemical processes
+      !!              and add it to the general trend of passive tracers equations
+      !!
+      !! ** Method  :   each now biological flux is calculated in function of now
+      !!              concentrations of tracers.
+      !!              depending on the tracer, these fluxes are sources or sinks.
+      !!              the total of the sources and sinks for each tracer
+      !!              is added to the general trend.
+      !!        
+      !!                      tra = tra + zf...tra - zftra...
+      !!                                     |         |
+      !!                                     |         |
+      !!                                  source      sink
+      !!        
+      !!              IF 'key_trc_diabio' defined , the biogeochemical trends
+      !!              for passive tracers are saved for futher diagnostics.
+      !!---------------------------------------------------------------------
+      !!
+      !!
+      !!----------------------------------------------------------------------            
+      !! Variable conventions
+      !!----------------------------------------------------------------------
+      !!
+      !! names: z*** - state variable 
+      !!        f*** - function (or temporary variable used in part of a function)
+      !!        x*** - parameter
+      !!        b*** - right-hand part (sources and sinks)
+      !!        i*** - integer variable (usually used in yes/no flags)
+      !!
+      !! time (integer timestep)
+      INTEGER, INTENT( in ) ::    kt
+      !!
+      !! spatial array indices
+      INTEGER  ::    ji,jj,jk,jn
+      !!
+      !! AXY (27/07/10): add in indices for depth horizons (for sinking flux
+      !!                 and seafloor iron inputs)
+      !! INTEGER  ::    i0100, i0200, i0500, i1000, i1100
+      !!
+      !! model state variables
+      REAL(wp) ::    zchn,zchd,zphn,zphd,zpds,zzmi
+      REAL(wp) ::    zzme,zdet,zdtc,zdin,zsil,zfer
+      REAL(wp) ::    zage
+# if defined key_roam
+      REAL(wp) ::    zdic, zalk, zoxy
+      REAL(wp) ::    ztmp, zsal
+# endif
+# if defined key_mocsy
+      REAL(wp) ::    zpho
+# endif
+      !!
+      !! integrated source and sink terms
+      REAL(wp) ::    b0
+      !! AXY (23/08/13): changed from individual variables for each flux to
+      !!                 an array that holds all fluxes
+      REAL(wp), DIMENSION(jp_medusa) ::    btra
+      !!
+      !! primary production and chl related quantities      
+      REAL(wp)                     ::    fthetan,faln,fchn1,fchn,fjln,fprn,frn
+      REAL(wp)                     ::    fthetad,fald,fchd1,fchd,fjld,fprd,frd
+      !! AXY (23/11/16): add in light-only limitation term (normalised 0-1 range)
+      REAL(wp)                     ::    fjlim_pn, fjlim_pd
+      !! AXY (03/02/11): add in Liebig terms
+      REAL(wp) ::    fpnlim, fpdlim
+      !! AXY (16/07/09): add in Eppley curve functionality
+      REAL(wp) ::    loc_T,fun_T,xvpnT,xvpdT
+      INTEGER  ::    ieppley
+      !! AXY (16/05/11): per Katya's prompting, add in new T-dependence
+      !!                 for phytoplankton growth only (i.e. no change
+      !!                 for remineralisation)
+      REAL(wp) ::    fun_Q10
+      !! AXY (01/03/10): add in mixed layer PP diagnostics
+      REAL(wp), DIMENSION(jpi,jpj) ::  fprn_ml,fprd_ml
+      !!
+      !! nutrient limiting factors
+      REAL(wp) ::    fnln,ffln            !! N and Fe
+      REAL(wp) ::    fnld,ffld,fsld,fsld2 !! N, Fe and Si
+      !!
+      !! silicon cycle
+      REAL(wp) ::    fsin,fnsi,fsin1,fnsi1,fnsi2,fprds,fsdiss
+      !!
+      !! iron cycle; includes parameters for Parekh et al. (2005) iron scheme
+      REAL(wp) ::    ffetop,ffebot,ffescav
+      REAL(wp) ::    xLgF, xFeT, xFeF, xFeL         !! state variables for iron-ligand system
+      REAL(wp), DIMENSION(jpi,jpj) ::  xFree        !! state variables for iron-ligand system
+      REAL(wp) ::    xb_coef_tmp, xb2M4ac           !! iron-ligand parameters
+      REAL(wp) ::    xmaxFeF,fdeltaFe               !! max Fe' parameters
+      !!
+      !! local parameters for Moore et al. (2004) alternative scavenging scheme
+      REAL(wp) ::    fbase_scav,fscal_sink,fscal_part,fscal_scav
+      !!
+      !! local parameters for Moore et al. (2008) alternative scavenging scheme
+      REAL(wp) ::    fscal_csink,fscal_sisink,fscal_casink
+      !!
+      !! local parameters for Galbraith et al. (2010) alternative scavenging scheme
+      REAL(wp) ::    xCscav1, xCscav2, xk_org, xORGscav  !! organic portion of scavenging
+      REAL(wp) ::    xk_inorg, xINORGscav                !! inorganic portion of scavenging
+      !!
+      !! microzooplankton grazing
+      REAL(wp) ::    fmi1,fmi,fgmipn,fgmid,fgmidc
+      REAL(wp) ::    finmi,ficmi,fstarmi,fmith,fmigrow,fmiexcr,fmiresp
+      !!
+      !! mesozooplankton grazing
+      REAL(wp) ::    fme1,fme,fgmepn,fgmepd,fgmepds,fgmezmi,fgmed,fgmedc
+      REAL(wp) ::    finme,ficme,fstarme,fmeth,fmegrow,fmeexcr,fmeresp
+      !!
+      !! mortality/Remineralisation (defunct parameter "fz" removed)
+      REAL(wp) ::    fdpn,fdpd,fdpds,fdzmi,fdzme,fdd
+# if defined key_roam
+      REAL(wp) ::    fddc
+# endif
+      REAL(wp) ::    fdpn2,fdpd2,fdpds2,fdzmi2,fdzme2
+      REAL(wp) ::    fslown, fslowc
+      REAL(wp), DIMENSION(jpi,jpj) ::    fslownflux, fslowcflux
+      REAL(wp) ::    fregen,fregensi
+      REAL(wp), DIMENSION(jpi,jpj) ::    fregenfast,fregenfastsi
+# if defined key_roam
+      REAL(wp) ::    fregenc
+      REAL(wp), DIMENSION(jpi,jpj) ::    fregenfastc
+# endif
+      !!
+      !! particle flux
+      REAL(WP) ::    fthk,fdep,fdep1,fdep2,flat,fcaco3
+      REAL(WP) ::    ftempn,ftempsi,ftempfe,ftempc,ftempca
+      REAL(wp) ::    freminn,freminsi,freminfe,freminc,freminca
+      REAL(wp), DIMENSION(jpi,jpj) ::    ffastn,ffastsi,ffastfe,ffastc,ffastca
+      REAL(wp) ::    fleftn,fleftsi,fleftfe,fleftc,fleftca
+      REAL(wp) ::    fheren,fheresi,fherefe,fherec,fhereca
+      REAL(wp) ::    fprotf
+      REAL(wp), DIMENSION(jpi,jpj) ::    fsedn,fsedsi,fsedfe,fsedc,fsedca
+      REAL(wp), DIMENSION(jpi,jpj) ::    fccd
+      REAL(wp) ::    fccd_dep
+      !! AXY (28/11/16): fix mbathy bug
+      INTEGER  ::    jmbathy
+      !!
+      !! AXY (06/07/11): alternative fast detritus schemes
+      REAL(wp) ::    fb_val, fl_sst
+      !!
+      !! AXY (08/07/11): fate of fast detritus reaching the seafloor
+      REAL(wp) ::    ffast2slown,ffast2slowfe,ffast2slowc
+      !!
+      !! conservation law
+      REAL(wp) ::    fnit0,fsil0,ffer0 
+# if defined key_roam
+      REAL(wp) ::    fcar0,falk0,foxy0 
+# endif      
+      !! 
+      !! temporary variables
+      REAL(wp) ::    fq0,fq1,fq2,fq3,fq4,fq5,fq6,fq7,fq8,fq9
+      !!
+      !! water column nutrient and flux integrals
+      REAL(wp), DIMENSION(jpi,jpj) ::    ftot_n,ftot_si,ftot_fe
+      REAL(wp), DIMENSION(jpi,jpj) ::    fflx_n,fflx_si,fflx_fe
+      REAL(wp), DIMENSION(jpi,jpj) ::    fifd_n,fifd_si,fifd_fe
+      REAL(wp), DIMENSION(jpi,jpj) ::    fofd_n,fofd_si,fofd_fe
+# if defined key_roam
+      REAL(wp), DIMENSION(jpi,jpj) ::    ftot_c,ftot_a,ftot_o2
+      REAL(wp), DIMENSION(jpi,jpj) ::    fflx_c,fflx_a,fflx_o2
+      REAL(wp), DIMENSION(jpi,jpj) ::    fifd_c,fifd_a,fifd_o2
+      REAL(wp), DIMENSION(jpi,jpj) ::    fofd_c,fofd_a,fofd_o2
+# endif
+      !!
+      !! zooplankton grazing integrals
+      REAL(wp), DIMENSION(jpi,jpj) ::    fzmi_i,fzmi_o,fzme_i,fzme_o
+      !!
+      !! limitation term temporary variables
+      REAL(wp), DIMENSION(jpi,jpj) ::    ftot_pn,ftot_pd
+      REAL(wp), DIMENSION(jpi,jpj) ::    ftot_zmi,ftot_zme,ftot_det,ftot_dtc
+      !! use ballast scheme (1) or simple exponential scheme (0; a conservation test)
+      INTEGER  ::    iball
+      !! use biological fluxes (1) or not (0)
+      INTEGER  ::    ibio_switch
+      !!
+      !! diagnose fluxes (should only be used in 1D runs)
+      INTEGER  ::    idf, idfval
+      !!
+      !! nitrogen and silicon production and consumption
+      REAL(wp) ::    fn_prod, fn_cons, fs_prod, fs_cons
+      REAL(wp), DIMENSION(jpi,jpj) ::    fnit_prod, fnit_cons, fsil_prod, fsil_cons
+# if defined key_roam
+      !!
+      !! flags to help with calculating the position of the CCD
+      INTEGER, DIMENSION(jpi,jpj) ::     i2_omcal,i2_omarg
+      !!
+      !! ROAM air-sea flux and diagnostic parameters
+      REAL(wp) ::    f_wind
+      !! AXY (24/11/16): add xCO2 variable for atmosphere (what we actually have)
+      REAL(wp) ::    f_xco2a
+      REAL(wp) ::    f_ph, f_pco2w, f_h2co3, f_hco3, f_co3, f_co2flux
+      REAL(wp) ::    f_TDIC, f_TALK, f_dcf, f_henry
+      REAL(wp) ::    f_uwind, f_vwind, f_pp0
+      REAL(wp) ::    f_kw660, f_o2flux, f_o2sat, f_o2sat3
+      REAL(wp), DIMENSION(jpi,jpj) ::    f_omcal, f_omarg
+      !!
+      !! AXY (23/06/15): additional diagnostics for MOCSY and oxygen
+      REAL(wp) ::    f_fco2w, f_BetaD, f_rhosw, f_opres, f_insitut, f_pco2atm, f_fco2atm
+      REAL(wp) ::    f_schmidtco2, f_kwco2, f_K0, f_co2starair, f_dpco2, f_kwo2
+      !! jpalm 14-07-2016: convert CO2flux diag from mmol/m2/d to kg/m2/s
+      REAL, PARAMETER :: weight_CO2_mol = 44.0095  !! g / mol
+      REAL, PARAMETER :: secs_in_day    = 86400.0  !! s / d
+      REAL, PARAMETER :: CO2flux_conv   = (1.e-6 * weight_CO2_mol) / secs_in_day
+
+      !!
+      INTEGER  ::    iters
+      REAL(wp) ::    f_year
+      INTEGER  ::    i_year
+      INTEGER  ::    iyr1, iyr2
+      !!
+      !! carbon, alkalinity production and consumption
+      REAL(wp) ::    fc_prod, fc_cons, fa_prod, fa_cons
+      REAL(wp), DIMENSION(jpi,jpj) ::    fcomm_resp
+      REAL(wp), DIMENSION(jpi,jpj) ::    fcar_prod, fcar_cons
+      !!
+      !! oxygen production and consumption (and non-consumption)
+      REAL(wp) ::    fo2_prod, fo2_cons, fo2_ncons, fo2_ccons
+      REAL(wp), DIMENSION(jpi,jpj) ::    foxy_prod, foxy_cons, foxy_anox
+      !! Jpalm (11-08-2014)
+      !! add DMS in MEDUSA for UKESM1 model
+      REAL(wp) ::    dms_surf
+      !! AXY (13/03/15): add in other DMS calculations
+      REAL(wp) ::    dms_andr, dms_simo, dms_aran, dms_hall, dms_andm, dms_nlim, dms_wtkn
+
+# endif
+      !! 
+      !! benthic fluxes
+      INTEGER  ::    ibenthic
+      REAL(wp), DIMENSION(jpi,jpj) :: f_sbenin_n, f_sbenin_fe,              f_sbenin_c
+      REAL(wp), DIMENSION(jpi,jpj) :: f_fbenin_n, f_fbenin_fe, f_fbenin_si, f_fbenin_c, f_fbenin_ca
+      REAL(wp), DIMENSION(jpi,jpj) :: f_benout_n, f_benout_fe, f_benout_si, f_benout_c, f_benout_ca
+      REAL(wp) ::    zfact
+      !! 
+      !! benthic fluxes of CaCO3 that shouldn't happen because of lysocline
+      REAL(wp), DIMENSION(jpi,jpj) :: f_benout_lyso_ca
+      !!
+      !! riverine fluxes
+      REAL(wp), DIMENSION(jpi,jpj) :: f_runoff, f_riv_n, f_riv_si, f_riv_c, f_riv_alk
+      !! AXY (19/07/12): variables for local riverine fluxes to handle inputs below surface
+      REAL(wp) ::    f_riv_loc_n, f_riv_loc_si, f_riv_loc_c, f_riv_loc_alk
+      !!
+      !! Jpalm -- 11-10-2015 -- adapt diag to iom_use
+      !! 2D var for diagnostics.
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: fprn2d, fdpn2d, fprd2d, fdpd2d, fprds2d, fsdiss2d, fgmipn2d
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: fgmid2d, fdzmi2d, fgmepn2d, fgmepd2d, fgmezmi2d, fgmed2d
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: fdzme2d, fslown2d, fdd2d, ffetop2d, ffebot2d, ffescav2d
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: fjln2d, fnln2d, ffln2d, fjld2d, fnld2d, ffld2d, fsld2d2
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: fsld2d, fregen2d, fregensi2d, ftempn2d, ftempsi2d, ftempfe2d
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: ftempc2d, ftempca2d, freminn2d, freminsi2d, freminfe2d
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: freminc2d, freminca2d
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zw2d
+# if defined key_roam
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: ffastca2d, rivn2d, rivsi2d, rivc2d, rivalk2d, fslowc2d
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: fdpn22d, fdpd22d, fdzmi22d, fdzme22d, zimesn2d, zimesd2d
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zimesc2d, zimesdc2d, ziexcr2d, ziresp2d, zigrow2d, zemesn2d
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zemesd2d, zemesc2d, zemesdc2d, zeexcr2d, zeresp2d, zegrow2d
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: mdetc2d, gmidc2d, gmedc2d, f_pco2a2d, f_pco2w2d, f_co2flux2d
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: f_TDIC2d, f_TALK2d, f_kw6602d, f_pp02d, f_o2flux2d, f_o2sat2d
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: dms_andr2d, dms_simo2d, dms_aran2d, dms_hall2d, dms_andm2d, dms_surf2d
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: iben_n2d, iben_fe2d, iben_c2d, iben_si2d, iben_ca2d, oben_n2d
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: oben_fe2d, oben_c2d, oben_si2d, oben_ca2d, sfr_ocal2d
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: sfr_oarg2d, lyso_ca2d 
+      !! AXY (23/11/16): extra MOCSY diagnostics
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: f_xco2a_2d, f_fco2w_2d, f_fco2a_2d
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: f_ocnrhosw_2d, f_ocnschco2_2d, f_ocnkwco2_2d
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: f_ocnk0_2d, f_co2starair_2d, f_ocndpco2_2d
+# endif
+      !!
+      !! 3D var for diagnostics.
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: tpp3d, detflux3d, remin3dn
+      !!
+# if defined key_roam
+      !! AXY (04/11/16)
+      !! 2D var for new CMIP6 diagnostics (behind a key_roam ifdef for simplicity)
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: fgco2, intdissic, intdissin, intdissisi, inttalk, o2min, zo2min
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: fbddtalk, fbddtdic, fbddtdife, fbddtdin, fbddtdisi
+      !!
+      !! 3D var for new CMIP6 diagnostics
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: tppd3
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: bddtalk3, bddtdic3, bddtdife3, bddtdin3, bddtdisi3
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: fd_nit3, fd_sil3, fd_car3, fd_cal3
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: co33, co3satarag3, co3satcalc3, dcalc3
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: expc3, expn3
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: fediss3, fescav3
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: migrazp3, migrazd3, megrazp3, megrazd3, megrazz3
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: o2sat3, pbsi3, pcal3, remoc3
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: pnlimj3, pnlimn3, pnlimfe3, pdlimj3, pdlimn3, pdlimfe3, pdlimsi3
+# endif
+      !!---------------------------------------------------------------------
+
+# if defined key_debug_medusa
+      IF (lwp) write (numout,*) 'trc_bio_medusa: variables defined'
+      CALL flush(numout)
+# endif 
+
+      !! AXY (20/11/14): alter this to report on first MEDUSA call
+      !! IF( kt == nit000 ) THEN
+      IF( kt == nittrc000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' trc_bio: MEDUSA bio-model'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~'
+	 IF(lwp) WRITE(numout,*) ' kt =',kt
+      ENDIF
+
+      !! AXY (13/01/12): is benthic model properly interactive? 0 = no, 1 = yes
+      ibenthic = 1
+
+      !! not sure what this is for; it's not used anywhere; commenting out
+      !! fbodn(:,:) = 0.e0   
+
+      !!
+      IF( ln_diatrc ) THEN
+         !! blank 2D diagnostic array
+         trc2d(:,:,:) = 0.e0
+         !!
+         !! blank 3D diagnostic array
+         trc3d(:,:,:,:) = 0.e0
+      ENDIF
+
+      !!----------------------------------------------------------------------
+      !! b0 is present for debugging purposes; using b0 = 0 sets the tendency
+      !! terms of all biological equations to 0.
+      !!----------------------------------------------------------------------
+      !!
+      !! AXY (03/09/14): probably not the smartest move ever, but it'll fit
+      !!                 the bill for now; another item on the things-to-sort-
+      !!		 out-in-the-future list ...
+# if defined key_kill_medusa
+      b0 = 0.
+# else
+      b0 = 1.
+# endif
+      !!----------------------------------------------------------------------
+      !! fast detritus ballast scheme (0 = no; 1 = yes)
+      !! alternative to ballast scheme is same scheme but with no ballast
+      !! protection (not dissimilar to Martin et al., 1987)
+      !!----------------------------------------------------------------------
+      !!
+      iball = 1
+
+      !!----------------------------------------------------------------------
+      !! full flux diagnostics (0 = no; 1 = yes); appear in ocean.output
+      !! these should *only* be used in 1D since they give comprehensive
+      !! output for ecological functions in the model; primarily used in
+      !! debugging
+      !!----------------------------------------------------------------------
+      !!
+      idf    = 0
+      !!
+      !! timer mechanism
+      if (kt/120*120.eq.kt) then
+         idfval = 1
+      else
+         idfval = 0
+      endif
+
+      !!----------------------------------------------------------------------
+      !! blank fast-sinking detritus 2D fields
+      !!----------------------------------------------------------------------
+      !!
+      ffastn(:,:)  = 0.0        !! organic nitrogen
+      ffastsi(:,:) = 0.0        !! biogenic silicon
+      ffastfe(:,:) = 0.0        !! organic iron
+      ffastc(:,:)  = 0.0        !! organic carbon
+      ffastca(:,:) = 0.0        !! biogenic calcium carbonate
+      !!
+      fsedn(:,:)   = 0.0        !! Seafloor flux of N 
+      fsedsi(:,:)  = 0.0        !! Seafloor flux of Si
+      fsedfe(:,:)  = 0.0        !! Seafloor flux of Fe
+      fsedc(:,:)   = 0.0        !! Seafloor flux of C
+      fsedca(:,:)  = 0.0        !! Seafloor flux of CaCO3
+      !!
+      fregenfast(:,:)   = 0.0   !! integrated  N regeneration (fast detritus)
+      fregenfastsi(:,:) = 0.0   !! integrated Si regeneration (fast detritus)
+# if defined key_roam
+      fregenfastc(:,:)  = 0.0   !! integrated  C regeneration (fast detritus)
+# endif
+      !!
+      fccd(:,:)    = 0.0        !! last depth level before CCD
+
+      !!----------------------------------------------------------------------
+      !! blank nutrient/flux inventories
+      !!----------------------------------------------------------------------
+      !!
+      fflx_n(:,:)  = 0.0        !! nitrogen flux total
+      fflx_si(:,:) = 0.0        !! silicon  flux total
+      fflx_fe(:,:) = 0.0        !! iron     flux total
+      fifd_n(:,:)  = 0.0        !! nitrogen fast detritus production
+      fifd_si(:,:) = 0.0        !! silicon  fast detritus production
+      fifd_fe(:,:) = 0.0        !! iron     fast detritus production
+      fofd_n(:,:)  = 0.0        !! nitrogen fast detritus remineralisation
+      fofd_si(:,:) = 0.0        !! silicon  fast detritus remineralisation
+      fofd_fe(:,:) = 0.0        !! iron     fast detritus remineralisation
+# if defined key_roam
+      fflx_c(:,:)  = 0.0        !! carbon     flux total
+      fflx_a(:,:)  = 0.0        !! alkalinity flux total
+      fflx_o2(:,:) = 0.0        !! oxygen     flux total
+      ftot_c(:,:)  = 0.0        !! carbon     inventory
+      ftot_a(:,:)  = 0.0        !! alkalinity inventory
+      ftot_o2(:,:) = 0.0        !! oxygen     inventory
+      fifd_c(:,:)  = 0.0        !! carbon     fast detritus production
+      fifd_a(:,:)  = 0.0        !! alkalinity fast detritus production
+      fifd_o2(:,:) = 0.0        !! oxygen     fast detritus production
+      fofd_c(:,:)  = 0.0        !! carbon     fast detritus remineralisation
+      fofd_a(:,:)  = 0.0        !! alkalinity fast detritus remineralisation
+      fofd_o2(:,:) = 0.0        !! oxygen     fast detritus remineralisation
+      !!
+      fnit_prod(:,:) = 0.0      !! (organic)   nitrogen production
+      fnit_cons(:,:) = 0.0      !! (organic)   nitrogen consumption
+      fsil_prod(:,:) = 0.0      !! (inorganic) silicon production
+      fsil_cons(:,:) = 0.0      !! (inorganic) silicon consumption
+      fcar_prod(:,:) = 0.0      !! (organic)   carbon production
+      fcar_cons(:,:) = 0.0      !! (organic)   carbon consumption
+      !!
+      foxy_prod(:,:) = 0.0      !! oxygen production
+      foxy_cons(:,:) = 0.0      !! oxygen consumption
+      foxy_anox(:,:) = 0.0      !! unrealised oxygen consumption
+      !!
+# endif
+      ftot_n(:,:)   = 0.0       !! N inventory 
+      ftot_si(:,:)  = 0.0       !! Si inventory
+      ftot_fe(:,:)  = 0.0       !! Fe inventory
+      ftot_pn(:,:)  = 0.0       !! integrated non-diatom phytoplankton
+      ftot_pd(:,:)  = 0.0       !! integrated diatom     phytoplankton
+      ftot_zmi(:,:) = 0.0       !! integrated microzooplankton
+      ftot_zme(:,:) = 0.0       !! integrated mesozooplankton
+      ftot_det(:,:) = 0.0       !! integrated slow detritus, nitrogen
+      ftot_dtc(:,:) = 0.0       !! integrated slow detritus, carbon
+      !!
+      fzmi_i(:,:)  = 0.0        !! material grazed by microzooplankton
+      fzmi_o(:,:)  = 0.0        !! ... sum of fate of this material
+      fzme_i(:,:)  = 0.0        !! material grazed by  mesozooplankton
+      fzme_o(:,:)  = 0.0        !! ... sum of fate of this material
+      !!
+      f_sbenin_n(:,:)  = 0.0    !! slow detritus N  -> benthic pool
+      f_sbenin_fe(:,:) = 0.0    !! slow detritus Fe -> benthic pool
+      f_sbenin_c(:,:)  = 0.0    !! slow detritus C  -> benthic pool
+      f_fbenin_n(:,:)  = 0.0    !! fast detritus N  -> benthic pool
+      f_fbenin_fe(:,:) = 0.0    !! fast detritus Fe -> benthic pool
+      f_fbenin_si(:,:) = 0.0    !! fast detritus Si -> benthic pool
+      f_fbenin_c(:,:)  = 0.0    !! fast detritus C  -> benthic pool
+      f_fbenin_ca(:,:) = 0.0    !! fast detritus Ca -> benthic pool
+      !!
+      f_benout_n(:,:)  = 0.0    !! benthic N  pool  -> dissolved
+      f_benout_fe(:,:) = 0.0    !! benthic Fe pool  -> dissolved
+      f_benout_si(:,:) = 0.0    !! benthic Si pool  -> dissolved
+      f_benout_c(:,:)  = 0.0    !! benthic C  pool  -> dissolved
+      f_benout_ca(:,:) = 0.0    !! benthic Ca pool  -> dissolved
+      !!
+      f_benout_lyso_ca(:,:) = 0.0 !! benthic Ca pool  -> dissolved (when it shouldn't!)
+      !!
+      f_runoff(:,:)  = 0.0      !! riverine runoff
+      f_riv_n(:,:)   = 0.0      !! riverine N   input 
+      f_riv_si(:,:)  = 0.0      !! riverine Si  input 
+      f_riv_c(:,:)   = 0.0      !! riverine C   input 
+      f_riv_alk(:,:) = 0.0      !! riverine alk input 
+      !! 
+      !! Jpalm -- 06-03-2017 -- Forgotten var to init
+      f_omarg(:,:) = 0.0        !!
+      f_omcal(:,:) = 0.0 
+      xFree(:,:) = 0.0          !! state variables for iron-ligand system
+      fcomm_resp(:,:) = 0.0 
+      fprn_ml(:,:) = 0.0        !! mixed layer PP diagnostics
+      fprd_ml(:,:) = 0.0        !! mixed layer PP diagnostics
+      !!
+      fslownflux(:,:) = 0.0
+      fslowcflux(:,:) = 0.0
+
+      !!
+      !! allocate and initiate 2D diag
+      !! -----------------------------
+      !! Juju :: add kt condition !!
+      IF ( lk_iomput .AND. .NOT.  ln_diatrc ) THEN 
+         !!
+         if ( kt == nittrc000 )   CALL trc_nam_iom_medusa !! initialise iom_use test
+         !!
+         CALL wrk_alloc( jpi, jpj,      zw2d )
+         zw2d(:,:)      = 0.0   !!
+         IF ( med_diag%PRN%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   fprn2d    )
+            fprn2d(:,:)      = 0.0 !!
+         ENDIF
+         IF ( med_diag%MPN%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   fdpn2d    )
+            fdpn2d(:,:)      = 0.0 !!
+         ENDIF
+         IF ( med_diag%PRD%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   fprd2d    )
+            fprd2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%MPD%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   fdpd2d    )
+            fdpd2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%OPAL%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   fprds2d    )
+            fprds2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%OPALDISS%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   fsdiss2d    )
+            fsdiss2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%GMIPn%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   fgmipn2d    )
+            fgmipn2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%GMID%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   fgmid2d    )
+            fgmid2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%MZMI%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   fdzmi2d    )
+            fdzmi2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%GMEPN%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   fgmepn2d    )
+            fgmepn2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%GMEPD%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   fgmepd2d    )
+            fgmepd2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%GMEZMI%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   fgmezmi2d    )
+            fgmezmi2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%GMED%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   fgmed2d    )
+            fgmed2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%MZME%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   fdzme2d    )
+            fdzme2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%DETN%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   fslown2d    )
+            fslown2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%MDET%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   fdd2d    )
+            fdd2d(:,:)      = 0.0 !!
+         ENDIF      
+         IF( med_diag%AEOLIAN%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   ffetop2d    )
+            ffetop2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%BENTHIC%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    ffebot2d   )
+            ffebot2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%SCAVENGE%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   ffescav2d    )
+            ffescav2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%PN_JLIM%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   fjln2d    )
+            fjln2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%PN_NLIM%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   fnln2d    )
+            fnln2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%PN_FELIM%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   ffln2d    )
+            ffln2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%PD_JLIM%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   fjld2d    )
+            fjld2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%PD_NLIM%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   fnld2d    )
+            fnld2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%PD_FELIM%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   ffld2d    )
+            ffld2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%PD_SILIM%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   fsld2d2    )
+            fsld2d2(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%PDSILIM2%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   fsld2d    )
+            fsld2d(:,:)      = 0.0 !!
+         ENDIF
+!!
+!! skip SDT_XXXX diagnostics here
+!!
+         IF( med_diag%TOTREG_N%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   fregen2d    )
+            fregen2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%TOTRG_SI%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   fregensi2d    )
+            fregensi2d(:,:)      = 0.0 !!
+         ENDIF
+!!
+!! skip REG_XXXX diagnostics here
+!!
+         IF( med_diag%FASTN%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   ftempn2d    )
+            ftempn2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%FASTSI%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   ftempsi2d    )
+            ftempsi2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%FASTFE%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,  ftempfe2d     )
+            ftempfe2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%FASTC%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,  ftempc2d     )
+            ftempc2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%FASTCA%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   ftempca2d    )
+            ftempca2d(:,:)      = 0.0 !!
+         ENDIF     
+!!
+!! skip FDT_XXXX, RG_XXXXF, FDS_XXXX, RGS_XXXXF diagnostics here
+!!
+         IF( med_diag%REMINN%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    freminn2d   )
+            freminn2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%REMINSI%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    freminsi2d   )
+            freminsi2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%REMINFE%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    freminfe2d   )
+            freminfe2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%REMINC%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   freminc2d    )
+            freminc2d(:,:)      = 0.0 !! 
+         ENDIF
+         IF( med_diag%REMINCA%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   freminca2d    )
+            freminca2d(:,:)      = 0.0 !!
+         ENDIF
+# if defined key_roam
+!!
+!! skip SEAFLRXX, MED_XXXX, INTFLX_XX, INT_XX, ML_XXX, OCAL_XXX, FE_XXXX, MED_XZE, WIND diagnostics here
+!!
+         IF( med_diag%RR_0100%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    ffastca2d   )
+            ffastca2d(:,:)      = 0.0 !!
+         ENDIF
+
+         IF( med_diag%ATM_PCO2%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    f_pco2a2d   )
+            f_pco2a2d(:,:)      = 0.0 !!
+         ENDIF
+!!
+!! skip OCN_PH diagnostic here
+!!
+         IF( med_diag%OCN_PCO2%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    f_pco2w2d   )
+            f_pco2w2d(:,:)      = 0.0 !!
+         ENDIF
+!!
+!! skip OCNH2CO3, OCN_HCO3, OCN_CO3 diagnostics here
+!!
+         IF( med_diag%CO2FLUX%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   f_co2flux2d    )
+            f_co2flux2d(:,:)      = 0.0 !!
+         ENDIF
+!!
+!! skip OM_XXX diagnostics here
+!!
+         IF( med_diag%TCO2%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   f_TDIC2d    )
+            f_TDIC2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%TALK%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    f_TALK2d   )
+            f_TALK2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%KW660%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    f_kw6602d   )
+            f_kw6602d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ATM_PP0%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    f_pp02d   )
+            f_pp02d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%O2FLUX%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   f_o2flux2d    )
+            f_o2flux2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%O2SAT%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    f_o2sat2d   )
+            f_o2sat2d(:,:)      = 0.0 !!
+         ENDIF 
+!!
+!! skip XXX_CCD diagnostics here
+!! 
+         IF( med_diag%SFR_OCAL%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    sfr_ocal2d  )
+            sfr_ocal2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%SFR_OARG%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    sfr_oarg2d  )
+            sfr_oarg2d(:,:)      = 0.0 !!
+         ENDIF
+!!
+!! skip XX_PROD, XX_CONS, O2_ANOX, RR_XXXX diagnostics here
+!! 
+         IF( med_diag%IBEN_N%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    iben_n2d  )
+            iben_n2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%IBEN_FE%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   iben_fe2d   )
+            iben_fe2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%IBEN_C%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   iben_c2d   )
+            iben_c2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%IBEN_SI%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   iben_si2d   )
+            iben_si2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%IBEN_CA%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   iben_ca2d   )
+            iben_ca2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%OBEN_N%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    oben_n2d  )
+            oben_n2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%OBEN_FE%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    oben_fe2d  )
+            oben_fe2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%OBEN_C%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    oben_c2d  )
+            oben_c2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%OBEN_SI%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    oben_si2d  )
+            oben_si2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%OBEN_CA%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    oben_ca2d  )
+            oben_ca2d(:,:)      = 0.0 !!
+         ENDIF
+!!
+!! skip BEN_XX diagnostics here
+!!
+         IF( med_diag%RIV_N%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    rivn2d   )
+            rivn2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%RIV_SI%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    rivsi2d   )
+            rivsi2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%RIV_C%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   rivc2d    )
+            rivc2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%RIV_ALK%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    rivalk2d   )
+            rivalk2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%DETC%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    fslowc2d   )
+            fslowc2d(:,:)      = 0.0 !!
+         ENDIF 
+!!
+!! skip SDC_XXXX, INVTXXX diagnostics here
+!!
+         IF( med_diag%LYSO_CA%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    lyso_ca2d  )
+            lyso_ca2d(:,:)      = 0.0 !!
+         ENDIF
+!!
+!! skip COM_RESP diagnostic here
+!!
+         IF( med_diag%PN_LLOSS%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    fdpn22d   )
+            fdpn22d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%PD_LLOSS%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    fdpd22d   )
+            fdpd22d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ZI_LLOSS%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    fdzmi22d   )
+            fdzmi22d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ZE_LLOSS%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   fdzme22d    )
+            fdzme22d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ZI_MES_N%dgsave ) THEN   
+            CALL wrk_alloc( jpi, jpj,   zimesn2d    )
+            zimesn2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ZI_MES_D%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    zimesd2d   )
+            zimesd2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ZI_MES_C%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    zimesc2d   )
+            zimesc2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ZI_MESDC%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    zimesdc2d   )
+            zimesdc2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ZI_EXCR%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,     ziexcr2d  )
+            ziexcr2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ZI_RESP%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    ziresp2d   )
+            ziresp2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ZI_GROW%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    zigrow2d   )
+            zigrow2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ZE_MES_N%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   zemesn2d    )
+            zemesn2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ZE_MES_D%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    zemesd2d   )
+            zemesd2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ZE_MES_C%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    zemesc2d   )
+            zemesc2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ZE_MESDC%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    zemesdc2d   )
+            zemesdc2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ZE_EXCR%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    zeexcr2d   )
+            zeexcr2d(:,:)      = 0.0 !!
+         ENDIF                  
+         IF( med_diag%ZE_RESP%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    zeresp2d   )
+            zeresp2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ZE_GROW%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    zegrow2d   )
+            zegrow2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%MDETC%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,   mdetc2d    )
+            mdetc2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%GMIDC%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    gmidc2d   )
+            gmidc2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%GMEDC%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj,    gmedc2d   )
+            gmedc2d(:,:)      = 0.0 !!
+         ENDIF
+!!
+!! skip INT_XXX diagnostics here
+!!
+         IF (jdms .eq. 1) THEN
+            IF( med_diag%DMS_SURF%dgsave ) THEN
+               CALL wrk_alloc( jpi, jpj,   dms_surf2d    )
+               dms_surf2d(:,:)      = 0.0 !!
+            ENDIF
+            IF( med_diag%DMS_ANDR%dgsave ) THEN
+               CALL wrk_alloc( jpi, jpj,   dms_andr2d    )
+               dms_andr2d(:,:)      = 0.0 !!
+            ENDIF
+            IF( med_diag%DMS_SIMO%dgsave ) THEN
+               CALL wrk_alloc( jpi, jpj,  dms_simo2d     )
+               dms_simo2d(:,:)      = 0.0 !!
+            ENDIF
+            IF( med_diag%DMS_ARAN%dgsave ) THEN
+               CALL wrk_alloc( jpi, jpj,   dms_aran2d    )
+               dms_aran2d(:,:)      = 0.0 !!
+            ENDIF
+            IF( med_diag%DMS_HALL%dgsave ) THEN
+               CALL wrk_alloc( jpi, jpj,   dms_hall2d    )
+               dms_hall2d(:,:)      = 0.0 !!
+            ENDIF
+            IF( med_diag%DMS_ANDM%dgsave ) THEN
+               CALL wrk_alloc( jpi, jpj,   dms_andm2d    )
+               dms_andm2d(:,:)      = 0.0 !!
+            ENDIF
+         ENDIF   
+         !!
+         !! AXY (24/11/16): extra MOCSY diagnostics, 2D
+         IF( med_diag%ATM_XCO2%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj, f_xco2a_2d      )
+            f_xco2a_2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%OCN_FCO2%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj, f_fco2w_2d      )
+            f_fco2w_2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%ATM_FCO2%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj, f_fco2a_2d      )
+            f_fco2a_2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%OCN_RHOSW%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj, f_ocnrhosw_2d   )
+            f_ocnrhosw_2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%OCN_SCHCO2%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj, f_ocnschco2_2d  )
+            f_ocnschco2_2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%OCN_KWCO2%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj, f_ocnkwco2_2d   )
+            f_ocnkwco2_2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%OCN_K0%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj, f_ocnk0_2d      )
+            f_ocnk0_2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%CO2STARAIR%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj, f_co2starair_2d )
+            f_co2starair_2d(:,:)      = 0.0 !!
+         ENDIF
+         IF( med_diag%OCN_DPCO2%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj, f_ocndpco2_2d   )
+            f_ocndpco2_2d(:,:)      = 0.0 !!
+         ENDIF
+# endif  
+         IF( med_diag%TPP3%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj, jpk,       tpp3d )
+            tpp3d(:,:,:)      = 0.0 !! 
+         ENDIF
+         IF( med_diag%DETFLUX3%dgsave ) THEN
+            CALL wrk_alloc( jpi, jpj, jpk,        detflux3d )
+            detflux3d(:,:,:)      = 0.0 !! 
+         ENDIF
+         IF( med_diag%REMIN3N%dgsave ) THEN
+             CALL wrk_alloc( jpi, jpj, jpk,        remin3dn )
+             remin3dn(:,:,:)      = 0.0 !! 
+          ENDIF
+          !! 
+          !! AXY (10/11/16): CMIP6 diagnostics, 2D
+          !! JPALM -- 17-11-16 -- put fgco2 alloc out of diag request
+          !!                   needed for coupling/passed through restart
+          !! IF( med_diag%FGCO2%dgsave ) THEN
+             CALL wrk_alloc( jpi, jpj,   fgco2    )
+             fgco2(:,:)      = 0.0 !!
+          !! ENDIF
+          IF( med_diag%INTDISSIC%dgsave ) THEN
+             CALL wrk_alloc( jpi, jpj,   intdissic    )
+             intdissic(:,:)  = 0.0 !!
+          ENDIF          
+          IF( med_diag%INTDISSIN%dgsave ) THEN
+             CALL wrk_alloc( jpi, jpj,   intdissin    )
+             intdissin(:,:)  = 0.0 !!
+          ENDIF          
+          IF( med_diag%INTDISSISI%dgsave ) THEN
+             CALL wrk_alloc( jpi, jpj,   intdissisi    )
+             intdissisi(:,:)  = 0.0 !!
+          ENDIF          
+          IF( med_diag%INTTALK%dgsave ) THEN
+             CALL wrk_alloc( jpi, jpj,   inttalk    )
+             inttalk(:,:)  = 0.0 !!
+          ENDIF          
+          IF( med_diag%O2min%dgsave ) THEN
+             CALL wrk_alloc( jpi, jpj,   o2min    )
+             o2min(:,:)  = 1.e3 !! set to high value as we're looking for min(o2)
+          ENDIF          
+          IF( med_diag%ZO2min%dgsave ) THEN
+             CALL wrk_alloc( jpi, jpj,   zo2min    )
+             zo2min(:,:)  = 0.0 !!
+          ENDIF          
+          IF( med_diag%FBDDTALK%dgsave  ) THEN
+             CALL wrk_alloc( jpi, jpj, fbddtalk  )
+             fbddtalk(:,:)  = 0.0 !! 
+          ENDIF
+          IF( med_diag%FBDDTDIC%dgsave  ) THEN
+             CALL wrk_alloc( jpi, jpj, fbddtdic  )
+             fbddtdic(:,:)  = 0.0 !! 
+          ENDIF
+          IF( med_diag%FBDDTDIFE%dgsave ) THEN
+             CALL wrk_alloc( jpi, jpj, fbddtdife )
+             fbddtdife(:,:) = 0.0 !! 
+          ENDIF
+          IF( med_diag%FBDDTDIN%dgsave  ) THEN
+             CALL wrk_alloc( jpi, jpj, fbddtdin  )
+             fbddtdin(:,:)  = 0.0 !! 
+          ENDIF
+          IF( med_diag%FBDDTDISI%dgsave ) THEN
+             CALL wrk_alloc( jpi, jpj, fbddtdisi )
+             fbddtdisi(:,:) = 0.0 !! 
+          ENDIF
+          !! 
+          !! AXY (10/11/16): CMIP6 diagnostics, 3D
+          IF( med_diag%TPPD3%dgsave     ) THEN
+             CALL wrk_alloc( jpi, jpj, jpk, tppd3     )
+             tppd3(:,:,:)     = 0.0 !! 
+          ENDIF
+          IF( med_diag%BDDTALK3%dgsave  ) THEN
+             CALL wrk_alloc( jpi, jpj, jpk, bddtalk3  )
+             bddtalk3(:,:,:)  = 0.0 !! 
+          ENDIF
+          IF( med_diag%BDDTDIC3%dgsave  ) THEN
+             CALL wrk_alloc( jpi, jpj, jpk, bddtdic3  )
+             bddtdic3(:,:,:)  = 0.0 !! 
+          ENDIF
+          IF( med_diag%BDDTDIFE3%dgsave ) THEN
+             CALL wrk_alloc( jpi, jpj, jpk, bddtdife3 )
+             bddtdife3(:,:,:) = 0.0 !! 
+          ENDIF
+          IF( med_diag%BDDTDIN3%dgsave  ) THEN
+             CALL wrk_alloc( jpi, jpj, jpk, bddtdin3  )
+             bddtdin3(:,:,:)  = 0.0 !! 
+          ENDIF
+          IF( med_diag%BDDTDISI3%dgsave ) THEN
+             CALL wrk_alloc( jpi, jpj, jpk, bddtdisi3 )
+             bddtdisi3(:,:,:) = 0.0 !! 
+          ENDIF
+          IF( med_diag%FD_NIT3%dgsave   ) THEN
+             CALL wrk_alloc( jpi, jpj, jpk, fd_nit3   )
+             fd_nit3(:,:,:)   = 0.0 !! 
+          ENDIF
+          IF( med_diag%FD_SIL3%dgsave   ) THEN
+             CALL wrk_alloc( jpi, jpj, jpk, fd_sil3   )
+             fd_sil3(:,:,:)   = 0.0 !! 
+          ENDIF
+          IF( med_diag%FD_CAR3%dgsave   ) THEN
+             CALL wrk_alloc( jpi, jpj, jpk, fd_car3   )
+             fd_car3(:,:,:)   = 0.0 !! 
+          ENDIF
+          IF( med_diag%FD_CAL3%dgsave   ) THEN
+             CALL wrk_alloc( jpi, jpj, jpk, fd_cal3   )
+             fd_cal3(:,:,:)   = 0.0 !! 
+          ENDIF
+          IF( med_diag%DCALC3%dgsave    ) THEN
+             CALL wrk_alloc( jpi, jpj, jpk, dcalc3    )
+             dcalc3(:,:,: )   = 0.0 !! 
+          ENDIF
+          IF( med_diag%EXPC3%dgsave     ) THEN
+             CALL wrk_alloc( jpi, jpj, jpk, expc3   )
+             expc3(:,:,: )    = 0.0 !! 
+          ENDIF
+          IF( med_diag%EXPN3%dgsave     ) THEN
+             CALL wrk_alloc( jpi, jpj, jpk, expn3   )
+             expn3(:,:,: )    = 0.0 !! 
+          ENDIF
+          IF( med_diag%FEDISS3%dgsave   ) THEN
+             CALL wrk_alloc( jpi, jpj, jpk, fediss3   )
+             fediss3(:,:,: )  = 0.0 !! 
+          ENDIF
+          IF( med_diag%FESCAV3%dgsave   ) THEN
+             CALL wrk_alloc( jpi, jpj, jpk, fescav3   )
+             fescav3(:,:,: )  = 0.0 !! 
+          ENDIF
+          IF( med_diag%MIGRAZP3%dgsave   ) THEN
+             CALL wrk_alloc( jpi, jpj, jpk, migrazp3  )
+             migrazp3(:,:,: )  = 0.0 !! 
+          ENDIF
+          IF( med_diag%MIGRAZD3%dgsave   ) THEN
+             CALL wrk_alloc( jpi, jpj, jpk, migrazd3  )
+             migrazd3(:,:,: )  = 0.0 !! 
+          ENDIF
+          IF( med_diag%MEGRAZP3%dgsave   ) THEN
+             CALL wrk_alloc( jpi, jpj, jpk, megrazp3  )
+             megrazp3(:,:,: )  = 0.0 !! 
+          ENDIF
+          IF( med_diag%MEGRAZD3%dgsave   ) THEN
+             CALL wrk_alloc( jpi, jpj, jpk, megrazd3  )
+             megrazd3(:,:,: )  = 0.0 !! 
+          ENDIF
+          IF( med_diag%MEGRAZZ3%dgsave   ) THEN
+             CALL wrk_alloc( jpi, jpj, jpk, megrazz3  )
+             megrazz3(:,:,: )  = 0.0 !! 
+          ENDIF
+          IF( med_diag%O2SAT3%dgsave     ) THEN
+             CALL wrk_alloc( jpi, jpj, jpk, o2sat3    )
+             o2sat3(:,:,: )    = 0.0 !! 
+          ENDIF
+          IF( med_diag%PBSI3%dgsave      ) THEN
+             CALL wrk_alloc( jpi, jpj, jpk, pbsi3     )
+             pbsi3(:,:,: )     = 0.0 !! 
+          ENDIF
+          IF( med_diag%PCAL3%dgsave      ) THEN
+             CALL wrk_alloc( jpi, jpj, jpk, pcal3     )
+             pcal3(:,:,: )     = 0.0 !! 
+          ENDIF
+          IF( med_diag%REMOC3%dgsave     ) THEN
+             CALL wrk_alloc( jpi, jpj, jpk, remoc3    )
+             remoc3(:,:,: )    = 0.0 !! 
+          ENDIF
+          IF( med_diag%PNLIMJ3%dgsave    ) THEN
+             CALL wrk_alloc( jpi, jpj, jpk, pnlimj3   )
+             pnlimj3(:,:,: )   = 0.0 !! 
+          ENDIF
+          IF( med_diag%PNLIMN3%dgsave    ) THEN
+             CALL wrk_alloc( jpi, jpj, jpk, pnlimn3   )
+             pnlimn3(:,:,: )   = 0.0 !! 
+          ENDIF
+          IF( med_diag%PNLIMFE3%dgsave   ) THEN
+             CALL wrk_alloc( jpi, jpj, jpk, pnlimfe3  )
+             pnlimfe3(:,:,: )  = 0.0 !! 
+          ENDIF
+          IF( med_diag%PDLIMJ3%dgsave    ) THEN
+             CALL wrk_alloc( jpi, jpj, jpk, pdlimj3   )
+             pdlimj3(:,:,: )   = 0.0 !! 
+          ENDIF
+          IF( med_diag%PDLIMN3%dgsave    ) THEN
+             CALL wrk_alloc( jpi, jpj, jpk, pdlimn3   )
+             pdlimn3(:,:,: )   = 0.0 !! 
+          ENDIF
+          IF( med_diag%PDLIMFE3%dgsave   ) THEN
+             CALL wrk_alloc( jpi, jpj, jpk, pdlimfe3  )
+             pdlimfe3(:,:,: )  = 0.0 !! 
+          ENDIF
+          IF( med_diag%PDLIMSI3%dgsave   ) THEN
+             CALL wrk_alloc( jpi, jpj, jpk, pdlimsi3  )
+             pdlimsi3(:,:,: )  = 0.0 !! 
+          ENDIF
+
+       ENDIF
+       !! lk_iomput                                   
+       !!
+# if defined key_axy_nancheck
+       DO jn = 1,jptra
+          !! fq0 = MINVAL(trn(:,:,:,jn))
+          !! fq1 = MAXVAL(trn(:,:,:,jn))
+          fq2 = SUM(trn(:,:,:,jn))
+          !! if (lwp) write (numout,'(a,2i6,3(1x,1pe15.5))') 'NAN-CHECK', &
+          !! &        kt, jn, fq0, fq1, fq2
+          !! AXY (30/01/14): much to our surprise, the next line doesn't work on HECTOR
+          !!                 and has been replaced here with a specialist routine
+          !! if (fq2 /= fq2 ) then
+          if ( ieee_is_nan( fq2 ) ) then
+             !! there's a NaN here
+             if (lwp) write(numout,*) 'NAN detected in field', jn, 'at time', kt, 'at position:'
+             DO jk = 1,jpk
+                DO jj = 1,jpj
+                   DO ji = 1,jpi
+                      !! AXY (30/01/14): "isnan" problem on HECTOR
+                      !! if (trn(ji,jj,jk,jn) /= trn(ji,jj,jk,jn)) then
+                      if ( ieee_is_nan( trn(ji,jj,jk,jn) ) ) then
+                         if (lwp) write (numout,'(a,1pe12.2,4i6)') 'NAN-CHECK', &
+                         &        tmask(ji,jj,jk), ji, jj, jk, jn
+                      endif
+                   enddo
+                enddo
+             enddo
+             CALL ctl_stop( 'trcbio_medusa, NAN in incoming tracer field' )
+          endif
+       ENDDO
+       CALL flush(numout)
+# endif
+
+# if defined key_debug_medusa
+      IF (lwp) write (numout,*) 'trc_bio_medusa: variables initialised and checked'
+      CALL flush(numout)
+# endif 
+
+# if defined key_roam
+      !!----------------------------------------------------------------------
+      !! calculate atmospheric pCO2
+      !!----------------------------------------------------------------------
+      !!
+      !! what's atmospheric pCO2 doing? (data start in 1859)
+      iyr1  = nyear - 1859 + 1
+      iyr2  = iyr1 + 1
+      if (iyr1 .le. 1) then
+         !! before 1860
+         f_xco2a = hist_pco2(1)
+      elseif (iyr2 .ge. 242) then
+         !! after 2099
+         f_xco2a = hist_pco2(242)
+      else
+         !! just right
+         fq0 = hist_pco2(iyr1)
+         fq1 = hist_pco2(iyr2)
+         fq2 = real(nsec_day) / (60.0 * 60.0 * 24.0)
+         !! AXY (14/06/12): tweaked to make more sense (and be correct)
+#  if defined key_bs_axy_yrlen
+         fq3 = (real(nday_year) - 1.0 + fq2) / 360.0  !! bugfix: for 360d year with HadGEM2-ES forcing
+#  else
+         fq3 = (real(nday_year) - 1.0 + fq2) / 365.0  !! original use of 365 days (not accounting for leap year or 360d year)
+#  endif
+         fq4 = (fq0 * (1.0 - fq3)) + (fq1 * fq3)
+         f_xco2a = fq4
+      endif
+#  if defined key_axy_pi_co2
+      !! f_xco2a = 284.725       !! CMIP5 pre-industrial pCO2
+      f_xco2a = 284.317          !! CMIP6 pre-industrial pCO2
+#  endif
+      !! IF(lwp) WRITE(numout,*) ' MEDUSA nyear     =', nyear
+      !! IF(lwp) WRITE(numout,*) ' MEDUSA nsec_day  =', real(nsec_day)
+      !! IF(lwp) WRITE(numout,*) ' MEDUSA nday_year =', real(nday_year)
+      !! AXY (29/01/14): remove surplus diagnostics
+      !! IF(lwp) WRITE(numout,*) ' MEDUSA fq0       =', fq0
+      !! IF(lwp) WRITE(numout,*) ' MEDUSA fq1       =', fq1
+      !! IF(lwp) WRITE(numout,*) ' MEDUSA fq2       =', fq2
+      !! IF(lwp) WRITE(numout,*) ' MEDUSA fq3       =', fq3
+      IF(lwp) WRITE(numout,*) ' MEDUSA atm pCO2  =', f_xco2a
+# endif
+
+# if defined key_debug_medusa
+      IF (lwp) write (numout,*) 'trc_bio_medusa: ready for carbonate chemistry'
+      IF (lwp) write (numout,*) 'trc_bio_medusa: kt = ', kt
+      IF (lwp) write (numout,*) 'trc_bio_medusa: nittrc000 = ', nittrc000
+      CALL flush(numout)
+# endif 
+
+# if defined key_roam
+      !! AXY (20/11/14): alter to call on first MEDUSA timestep and then every
+      !!                 month (this is hardwired as 960 timesteps but should
+      !!                 be calculated and done properly
+      !! IF( kt == nit000 .or. mod(kt,1920) == 0 ) THEN
+      !! IF( kt == nittrc000 .or. mod(kt,960) == 0 ) THEN 
+      !!=============================
+      !! Jpalm -- 07-10-2016 -- need to change carb-chem frequency call :
+      !!          we don't want to call on the first time-step of all run submission, 
+      !!          but only on the very first time-step, and then every month
+      !!          So we call on nittrc000 if not restarted run, 
+      !!          else if one month after last call.
+      !!          assume one month is 30d --> 3600*24*30 : 2592000s
+      !!          try to call carb-chem at 1st month's tm-stp : x * 30d + 1*rdt(i.e: mod = rdt)   
+      !!          ++ need to pass carb-chem output var through restarts
+      If ( ( kt == nittrc000 .AND. .NOT.ln_rsttr ) .OR. mod(kt*rdt,2592000.) == rdt ) THEN
+         !!----------------------------------------------------------------------
+         !! Calculate the carbonate chemistry for the whole ocean on the first
+         !! simulation timestep and every month subsequently; the resulting 3D
+         !! field of omega calcite is used to determine the depth of the CCD
+         !!----------------------------------------------------------------------
+         !!
+         IF(lwp) WRITE(numout,*) ' MEDUSA calculating all carbonate chemistry at kt =', kt
+         CALL flush(numout)
+         !! blank flags
+         i2_omcal(:,:) = 0
+         i2_omarg(:,:) = 0
+         !! loop over 3D space
+         DO jk = 1,jpk
+            DO jj = 2,jpjm1
+               DO ji = 2,jpim1
+                  !! OPEN wet point IF..THEN loop
+                  if (tmask(ji,jj,jk).eq.1) then
+                     IF (lk_oasis) THEN
+                        f_xco2a = PCO2a_in_cpl(ji,jj)        !! use 2D atm xCO2 from atm coupling
+                     ENDIF
+                     !! do carbonate chemistry
+                     !!
+                     fdep2 = fsdept(ji,jj,jk)           !! set up level midpoint
+                     !! AXY (28/11/16): local seafloor depth
+                     !!                 previously mbathy(ji,jj) - 1, now mbathy(ji,jj)
+                     jmbathy = mbathy(ji,jj)
+                     !!
+                     !! set up required state variables
+                     zdic = max(0.,trn(ji,jj,jk,jpdic)) !! dissolved inorganic carbon
+                     zalk = max(0.,trn(ji,jj,jk,jpalk)) !! alkalinity
+                     ztmp = tsn(ji,jj,jk,jp_tem)        !! temperature
+                     zsal = tsn(ji,jj,jk,jp_sal)        !! salinity
+#  if defined key_mocsy
+                     zsil = max(0.,trn(ji,jj,jk,jpsil))        !! silicic acid
+                     zpho = max(0.,trn(ji,jj,jk,jpdin)) / 16.0 !! phosphate via DIN and Redfield
+#  endif
+		     !!
+		     !! AXY (28/02/14): check input fields
+		     if (ztmp .lt. -3.0 .or. ztmp .gt. 40.0 ) then
+                        IF(lwp) WRITE(numout,*) ' trc_bio_medusa: T WARNING 3D, ', &
+                        tsb(ji,jj,jk,jp_tem), tsn(ji,jj,jk,jp_tem), ' at (',    &
+                        ji, ',', jj, ',', jk, ') at time', kt
+			IF(lwp) WRITE(numout,*) ' trc_bio_medusa: T SWITCHING 3D, ', &
+			tsn(ji,jj,jk,jp_tem), ' -> ', tsb(ji,jj,jk,jp_tem)
+                        ztmp = tsb(ji,jj,jk,jp_tem)     !! temperature
+                     endif
+		     if (zsal .lt. 0.0 .or. zsal .gt. 45.0 ) then
+                        IF(lwp) WRITE(numout,*) ' trc_bio_medusa: S WARNING 3D, ', &
+                        tsb(ji,jj,jk,jp_sal), tsn(ji,jj,jk,jp_sal), ' at (',    &
+                        ji, ',', jj, ',', jk, ') at time', kt
+                     endif
+                     !!
+                     !! blank input variables not used at this stage (they relate to air-sea flux)
+                     f_kw660 = 1.0
+                     f_pp0   = 1.0
+                     !!
+                     !! calculate carbonate chemistry at grid cell midpoint
+#  if defined key_mocsy
+                     !! AXY (22/06/15): use Orr & Epitalon (2015) MOCSY-2 carbonate
+                     !!                 chemistry package
+                     CALL mocsy_interface( ztmp, zsal, zalk, zdic, zsil, zpho,         &    ! inputs
+                     f_pp0, fdep2, gphit(ji,jj), f_kw660, f_xco2a, 1,                  &    ! inputs
+                     f_ph, f_pco2w, f_fco2w, f_h2co3, f_hco3, f_co3, f_omarg(ji,jj),   &    ! outputs
+                     f_omcal(ji,jj), f_BetaD, f_rhosw, f_opres, f_insitut,             &    ! outputs
+                     f_pco2atm, f_fco2atm, f_schmidtco2, f_kwco2, f_K0,                &    ! outputs
+                     f_co2starair, f_co2flux, f_dpco2 )                                     ! outputs
+                     !!
+                     f_TDIC = (zdic / f_rhosw) * 1000. ! mmol / m3 -> umol / kg
+                     f_TALK = (zalk / f_rhosw) * 1000. !  meq / m3 ->  ueq / kg
+                     f_dcf  = f_rhosw
+#  else
+                     !! AXY (22/06/15): use old PML carbonate chemistry package (the
+                     !!                 MEDUSA-2 default)
+                     CALL trc_co2_medusa( ztmp, zsal, zdic, zalk, fdep2, f_kw660,      &    ! inputs
+                     f_xco2a, f_ph, f_pco2w, f_h2co3, f_hco3, f_co3, f_omcal(ji,jj),   &    ! outputs
+                     f_omarg(ji,jj), f_co2flux, f_TDIC, f_TALK, f_dcf, f_henry, iters)      ! outputs
+                     !! 
+                     !! AXY (28/02/14): check output fields
+                     if (iters .eq. 25) then
+                        IF(lwp) WRITE(numout,*) ' trc_bio_medusa: 3D ITERS WARNING, ', &
+                        iters, ' AT (', ji, ', ', jj, ', ', jk, ') AT ', kt
+                     endif
+#  endif
+                     !!
+                     !! store 3D outputs
+                     f3_pH(ji,jj,jk)    = f_ph
+                     f3_h2co3(ji,jj,jk) = f_h2co3
+                     f3_hco3(ji,jj,jk)  = f_hco3
+                     f3_co3(ji,jj,jk)   = f_co3
+                     f3_omcal(ji,jj,jk) = f_omcal(ji,jj)
+                     f3_omarg(ji,jj,jk) = f_omarg(ji,jj)
+                     !!
+                     !! CCD calculation: calcite
+                     if (i2_omcal(ji,jj) .eq. 0 .and. f_omcal(ji,jj) .lt. 1.0) then
+                        if (jk .eq. 1) then
+                           f2_ccd_cal(ji,jj) = fdep2
+                        else
+                           fq0 = f3_omcal(ji,jj,jk-1) - f_omcal(ji,jj)
+                           fq1 = f3_omcal(ji,jj,jk-1) - 1.0
+                           fq2 = fq1 / (fq0 + tiny(fq0))
+                           fq3 = fdep2 - fsdept(ji,jj,jk-1)
+                           fq4 = fq2 * fq3
+                           f2_ccd_cal(ji,jj) = fsdept(ji,jj,jk-1) + fq4
+                        endif
+                        i2_omcal(ji,jj)   = 1
+                     endif
+                     if ( i2_omcal(ji,jj) .eq. 0 .and. jk .eq. jmbathy ) then
+                        !! reached seafloor and still no dissolution; set to seafloor (W-point)
+                        f2_ccd_cal(ji,jj) = fsdepw(ji,jj,jk+1)
+                        i2_omcal(ji,jj)   = 1
+                     endif
+                     !!
+                     !! CCD calculation: aragonite
+                     if (i2_omarg(ji,jj) .eq. 0 .and. f_omarg(ji,jj) .lt. 1.0) then
+                        if (jk .eq. 1) then
+                           f2_ccd_arg(ji,jj) = fdep2
+                        else
+                           fq0 = f3_omarg(ji,jj,jk-1) - f_omarg(ji,jj)
+                           fq1 = f3_omarg(ji,jj,jk-1) - 1.0
+                           fq2 = fq1 / (fq0 + tiny(fq0))
+                           fq3 = fdep2 - fsdept(ji,jj,jk-1)
+                           fq4 = fq2 * fq3
+                           f2_ccd_arg(ji,jj) = fsdept(ji,jj,jk-1) + fq4
+                        endif
+                        i2_omarg(ji,jj)   = 1
+                     endif
+                     if ( i2_omarg(ji,jj) .eq. 0 .and. jk .eq. jmbathy ) then
+                        !! reached seafloor and still no dissolution; set to seafloor (W-point)
+                        f2_ccd_arg(ji,jj) = fsdepw(ji,jj,jk+1)
+                        i2_omarg(ji,jj)   = 1
+                     endif
+                  endif
+               ENDDO
+            ENDDO
+         ENDDO
+      ENDIF
+# endif
+
+# if defined key_debug_medusa
+      IF (lwp) write (numout,*) 'trc_bio_medusa: ready for full domain calculations'
+      CALL flush(numout)
+# endif 
+
+      !!----------------------------------------------------------------------
+      !! MEDUSA has unified equation through the water column
+      !! (Diff. from LOBSTER which has two sets: bio- and non-bio layers) 
+      !! Statement below in LOBSTER is different: DO jk = 1, jpkbm1          
+      !!----------------------------------------------------------------------
+      !!
+      !! NOTE: the ordering of the loops below differs from that of some other
+      !! models; looping over the vertical dimension is the outermost loop and
+      !! this complicates some calculations (e.g. storage of vertical fluxes
+      !! that can otherwise be done via a singular variable require 2D fields
+      !! here); however, these issues are relatively easily resolved, but the
+      !! loops CANNOT be reordered without potentially causing code efficiency
+      !! problems (e.g. array indexing means that reordering the loops would
+      !! require skipping between widely-spaced memory location; potentially
+      !! outside those immediately cached)
+      !!
+      !! OPEN vertical loop
+      DO jk = 1,jpk
+         !! OPEN horizontal loops
+         DO jj = 2,jpjm1
+         DO ji = 2,jpim1
+            !! OPEN wet point IF..THEN loop
+            if (tmask(ji,jj,jk).eq.1) then               
+               !!======================================================================
+               !! SETUP LOCAL GRID CELL
+               !!======================================================================
+               !!
+               !!---------------------------------------------------------------------
+               !! Some notes on grid vertical structure
+               !! - fsdepw(ji,jj,jk) is the depth of the upper surface of level jk
+               !! - fsde3w(ji,jj,jk) is *approximately* the midpoint of level jk
+               !! - fse3t(ji,jj,jk)  is the thickness of level jk
+               !!---------------------------------------------------------------------
+               !!
+               !! AXY (11/12/08): set up level thickness
+               fthk  = fse3t(ji,jj,jk)
+               !! AXY (25/02/10): set up level depth (top of level)
+               fdep  = fsdepw(ji,jj,jk)
+               !! AXY (01/03/10): set up level depth (bottom of level)
+               fdep1 = fdep + fthk
+               !! AXY (28/11/16): local seafloor depth
+               !!                 previously mbathy(ji,jj) - 1, now mbathy(ji,jj)
+               jmbathy = mbathy(ji,jj)
+               !!
+               !! set up model tracers
+               !! negative values of state variables are not allowed to
+               !! contribute to the calculated fluxes
+               zchn = max(0.,trn(ji,jj,jk,jpchn)) !! non-diatom chlorophyll
+               zchd = max(0.,trn(ji,jj,jk,jpchd)) !! diatom chlorophyll
+               zphn = max(0.,trn(ji,jj,jk,jpphn)) !! non-diatoms
+               zphd = max(0.,trn(ji,jj,jk,jpphd)) !! diatoms
+               zpds = max(0.,trn(ji,jj,jk,jppds)) !! diatom silicon
+               !! AXY (28/01/10): probably need to take account of chl/biomass connection
+               if (zchn.eq.0.) zphn = 0.
+               if (zchd.eq.0.) zphd = 0.
+               if (zphn.eq.0.) zchn = 0.
+               if (zphd.eq.0.) zchd = 0.
+	       !! AXY (23/01/14): duh - why did I forget diatom silicon?
+	       if (zpds.eq.0.) zphd = 0.
+	       if (zphd.eq.0.) zpds = 0.
+               zzmi = max(0.,trn(ji,jj,jk,jpzmi)) !! microzooplankton
+               zzme = max(0.,trn(ji,jj,jk,jpzme)) !! mesozooplankton
+               zdet = max(0.,trn(ji,jj,jk,jpdet)) !! detrital nitrogen
+               zdin = max(0.,trn(ji,jj,jk,jpdin)) !! dissolved inorganic nitrogen
+               zsil = max(0.,trn(ji,jj,jk,jpsil)) !! dissolved silicic acid
+               zfer = max(0.,trn(ji,jj,jk,jpfer)) !! dissolved "iron"
+# if defined key_roam
+               zdtc = max(0.,trn(ji,jj,jk,jpdtc)) !! detrital carbon
+               zdic = max(0.,trn(ji,jj,jk,jpdic)) !! dissolved inorganic carbon
+               zalk = max(0.,trn(ji,jj,jk,jpalk)) !! alkalinity
+               zoxy = max(0.,trn(ji,jj,jk,jpoxy)) !! oxygen
+#  if defined key_axy_carbchem && defined key_mocsy
+               zpho = max(0.,trn(ji,jj,jk,jpdin)) / 16.0 !! phosphate via DIN and Redfield
+#  endif
+               !!
+               !! also need physical parameters for gas exchange calculations
+               ztmp = tsn(ji,jj,jk,jp_tem)
+               zsal = tsn(ji,jj,jk,jp_sal)
+               !!
+	       !! AXY (28/02/14): check input fields
+               if (ztmp .lt. -3.0 .or. ztmp .gt. 40.0 ) then
+                  IF(lwp) WRITE(numout,*) ' trc_bio_medusa: T WARNING 2D, ', &
+                  tsb(ji,jj,jk,jp_tem), tsn(ji,jj,jk,jp_tem), ' at (',    &
+                  ji, ',', jj, ',', jk, ') at time', kt
+		  IF(lwp) WRITE(numout,*) ' trc_bio_medusa: T SWITCHING 2D, ', &
+                  tsn(ji,jj,jk,jp_tem), ' -> ', tsb(ji,jj,jk,jp_tem)
+                  ztmp = tsb(ji,jj,jk,jp_tem) !! temperature
+               endif
+               if (zsal .lt. 0.0 .or. zsal .gt. 45.0 ) then
+                  IF(lwp) WRITE(numout,*) ' trc_bio_medusa: S WARNING 2D, ', &
+                  tsb(ji,jj,jk,jp_sal), tsn(ji,jj,jk,jp_sal), ' at (',    &
+                  ji, ',', jj, ',', jk, ') at time', kt
+               endif
+# else
+               zdtc = zdet * xthetad              !! implicit detrital carbon
+# endif
+# if defined key_debug_medusa
+               if (idf.eq.1) then
+               !! AXY (15/01/10)
+                  if (trn(ji,jj,jk,jpdin).lt.0.) then
+                     IF (lwp) write (numout,*) '------------------------------'
+                     IF (lwp) write (numout,*) 'NEGATIVE DIN ERROR =', trn(ji,jj,jk,jpdin)
+                     IF (lwp) write (numout,*) 'NEGATIVE DIN ERROR @', ji, jj, jk, kt
+                  endif
+                  if (trn(ji,jj,jk,jpsil).lt.0.) then
+                     IF (lwp) write (numout,*) '------------------------------'
+                     IF (lwp) write (numout,*) 'NEGATIVE SIL ERROR =', trn(ji,jj,jk,jpsil)
+                     IF (lwp) write (numout,*) 'NEGATIVE SIL ERROR @', ji, jj, jk, kt
+                  endif
+#  if defined key_roam
+                  if (trn(ji,jj,jk,jpdic).lt.0.) then
+                     IF (lwp) write (numout,*) '------------------------------'
+                     IF (lwp) write (numout,*) 'NEGATIVE DIC ERROR =', trn(ji,jj,jk,jpdic)
+                     IF (lwp) write (numout,*) 'NEGATIVE DIC ERROR @', ji, jj, jk, kt
+                  endif
+                  if (trn(ji,jj,jk,jpalk).lt.0.) then
+                     IF (lwp) write (numout,*) '------------------------------'
+                     IF (lwp) write (numout,*) 'NEGATIVE ALK ERROR =', trn(ji,jj,jk,jpalk)
+                     IF (lwp) write (numout,*) 'NEGATIVE ALK ERROR @', ji, jj, jk, kt
+                  endif
+                  if (trn(ji,jj,jk,jpoxy).lt.0.) then
+                     IF (lwp) write (numout,*) '------------------------------'
+                     IF (lwp) write (numout,*) 'NEGATIVE OXY ERROR =', trn(ji,jj,jk,jpoxy)
+                     IF (lwp) write (numout,*) 'NEGATIVE OXY ERROR @', ji, jj, jk, kt
+                  endif
+#  endif
+               endif
+# endif
+# if defined key_debug_medusa
+               !! report state variable values
+               if (idf.eq.1.AND.idfval.eq.1) then
+                  IF (lwp) write (numout,*) '------------------------------'
+                  IF (lwp) write (numout,*) 'fthk(',jk,') = ', fthk
+                  IF (lwp) write (numout,*) 'zphn(',jk,') = ', zphn
+                  IF (lwp) write (numout,*) 'zphd(',jk,') = ', zphd
+                  IF (lwp) write (numout,*) 'zpds(',jk,') = ', zpds
+                  IF (lwp) write (numout,*) 'zzmi(',jk,') = ', zzmi
+                  IF (lwp) write (numout,*) 'zzme(',jk,') = ', zzme
+                  IF (lwp) write (numout,*) 'zdet(',jk,') = ', zdet
+                  IF (lwp) write (numout,*) 'zdin(',jk,') = ', zdin
+                  IF (lwp) write (numout,*) 'zsil(',jk,') = ', zsil
+                  IF (lwp) write (numout,*) 'zfer(',jk,') = ', zfer
+#  if defined key_roam
+                  IF (lwp) write (numout,*) 'zdtc(',jk,') = ', zdtc
+                  IF (lwp) write (numout,*) 'zdic(',jk,') = ', zdic
+                  IF (lwp) write (numout,*) 'zalk(',jk,') = ', zalk
+                  IF (lwp) write (numout,*) 'zoxy(',jk,') = ', zoxy                  
+#  endif
+               endif
+# endif
+
+# if defined key_debug_medusa
+               if (idf.eq.1.AND.idfval.eq.1.AND.jk.eq.1) then
+                  IF (lwp) write (numout,*) '------------------------------'
+                  IF (lwp) write (numout,*) 'dust      = ', dust(ji,jj)
+               endif
+# endif
+
+               !! sum tracers for inventory checks
+               IF( lk_iomput ) THEN
+                  IF ( med_diag%INVTN%dgsave )   THEN
+                     ftot_n(ji,jj)  = ftot_n(ji,jj) + &
+                             (fthk * ( zphn + zphd + zzmi + zzme + zdet + zdin ) )
+                  ENDIF
+                  IF ( med_diag%INVTSI%dgsave )  THEN
+                     ftot_si(ji,jj) = ftot_si(ji,jj) + & 
+                             (fthk * ( zpds + zsil ) )
+                  ENDIF
+                  IF ( med_diag%INVTFE%dgsave )  THEN
+                     ftot_fe(ji,jj) = ftot_fe(ji,jj) + & 
+                             (fthk * ( xrfn * ( zphn + zphd + zzmi + zzme + zdet ) + zfer ) )
+                  ENDIF
+# if defined key_roam
+                  IF ( med_diag%INVTC%dgsave )  THEN
+                     ftot_c(ji,jj)  = ftot_c(ji,jj) + & 
+                             (fthk * ( (xthetapn * zphn) + (xthetapd * zphd) + &
+                             (xthetazmi * zzmi) + (xthetazme * zzme) + zdtc +   &
+                             zdic ) )
+                  ENDIF
+                  IF ( med_diag%INVTALK%dgsave ) THEN
+                     ftot_a(ji,jj)  = ftot_a(ji,jj) + (fthk * ( zalk ) )
+                  ENDIF
+                  IF ( med_diag%INVTO2%dgsave )  THEN
+                     ftot_o2(ji,jj) = ftot_o2(ji,jj) + (fthk * ( zoxy ) )
+                  ENDIF
+                  !!
+                  !! AXY (10/11/16): CMIP6 diagnostics
+                  IF ( med_diag%INTDISSIC%dgsave ) THEN
+                     intdissic(ji,jj) = intdissic(ji,jj) + (fthk * zdic)
+                  ENDIF
+                  IF ( med_diag%INTDISSIN%dgsave ) THEN
+                     intdissin(ji,jj) = intdissin(ji,jj) + (fthk * zdin)
+                  ENDIF
+                  IF ( med_diag%INTDISSISI%dgsave ) THEN
+                     intdissisi(ji,jj) = intdissisi(ji,jj) + (fthk * zsil)
+                  ENDIF
+                  IF ( med_diag%INTTALK%dgsave ) THEN
+                     inttalk(ji,jj) = inttalk(ji,jj) + (fthk * zalk)
+                  ENDIF
+                  IF ( med_diag%O2min%dgsave ) THEN
+                     if ( zoxy < o2min(ji,jj) ) then
+                        o2min(ji,jj)  = zoxy
+                        IF ( med_diag%ZO2min%dgsave ) THEN
+                           zo2min(ji,jj) = (fdep + fdep1) / 2. !! layer midpoint
+                        ENDIF
+                     endif
+                  ENDIF
+# endif
+               ENDIF
+
+               CALL flush(numout)
+
+               !!======================================================================
+               !! LOCAL GRID CELL CALCULATIONS
+               !!======================================================================
+               !!
+# if defined key_roam
+               if ( jk .eq. 1 ) then
+                  !!----------------------------------------------------------------------
+                  !! Air-sea gas exchange
+                  !!----------------------------------------------------------------------
+                  !!
+                  !! AXY (17/07/14): zwind_i and zwind_j do not exist in this
+                  !!                 version of NEMO because it does not include
+                  !!                 the SBC changes that our local version has
+                  !!                 for accessing the HadGEM2 forcing; they 
+                  !!                 could be added, but an alternative approach
+                  !!                 is to make use of wndm from oce_trc.F90
+                  !!                 which is wind speed at 10m (which is what
+                  !!                 is required here; this may need to be
+                  !!                 revisited when MEDUSA properly interacts
+                  !!                 with UKESM1 physics
+                  !!
+                  f_wind  = wndm(ji,jj)
+                  IF (lk_oasis) THEN
+                     f_xco2a = PCO2a_in_cpl(ji,jj)        !! use 2D atm xCO2 from atm coupling
+                  ENDIF
+                  !!
+                  !! AXY (23/06/15): as part of an effort to update the carbonate chemistry
+                  !!                 in MEDUSA, the gas transfer velocity used in the carbon
+                  !!                 and oxygen cycles has been harmonised and is calculated
+                  !!                 by the same function here; this harmonisation includes
+                  !!                 changes to the PML carbonate chemistry scheme so that
+                  !!                 it too makes use of the same gas transfer velocity; the
+                  !!                 preferred parameterisation of this is Wanninkhof (2014),
+                  !!                 option 7
+                  !!
+#   if defined key_debug_medusa
+                     IF (lwp) write (numout,*) 'trc_bio_medusa: entering gas_transfer'
+                     CALL flush(numout)
+#   endif
+                  CALL gas_transfer( f_wind, 1, 7, &  ! inputs
+                                     f_kw660 )        ! outputs
+#   if defined key_debug_medusa
+                     IF (lwp) write (numout,*) 'trc_bio_medusa: exiting gas_transfer'
+                     CALL flush(numout)
+#   endif
+                  !!
+                  !! air pressure (atm); ultimately this will use air pressure at the base
+                  !! of the UKESM1 atmosphere 
+                  !!                                     
+                  f_pp0   = 1.0
+                  !!
+                  !! IF(lwp) WRITE(numout,*) ' MEDUSA ztmp    =', ztmp
+                  !! IF(lwp) WRITE(numout,*) ' MEDUSA zwind_i =', zwind_i(ji,jj)
+                  !! IF(lwp) WRITE(numout,*) ' MEDUSA zwind_j =', zwind_j(ji,jj)
+                  !! IF(lwp) WRITE(numout,*) ' MEDUSA f_wind  =', f_wind
+                  !! IF(lwp) WRITE(numout,*) ' MEDUSA fr_i    =', fr_i(ji,jj)
+                  !!
+#  if defined key_axy_carbchem
+#   if defined key_mocsy
+                  !!
+                  !! AXY (22/06/15): use Orr & Epitalon (2015) MOCSY-2 carbonate
+                  !!                 chemistry package; note that depth is set to
+                  !!                 zero in this call
+                  CALL mocsy_interface( ztmp, zsal, zalk, zdic, zsil, zpho,        &  ! inputs
+                  f_pp0, 0.0, gphit(ji,jj), f_kw660, f_xco2a, 1,                   &  ! inputs
+                  f_ph, f_pco2w, f_fco2w, f_h2co3, f_hco3, f_co3, f_omarg(ji,jj),  &  ! outputs
+                  f_omcal(ji,jj), f_BetaD, f_rhosw, f_opres, f_insitut,            &  ! outputs
+                  f_pco2atm, f_fco2atm, f_schmidtco2, f_kwco2, f_K0,               &  ! outputs
+                  f_co2starair, f_co2flux, f_dpco2 )                                  ! outputs
+                  !!
+                  f_TDIC = (zdic / f_rhosw) * 1000. ! mmol / m3 -> umol / kg
+                  f_TALK = (zalk / f_rhosw) * 1000. !  meq / m3 ->  ueq / kg
+                  f_dcf  = f_rhosw
+#   else                  
+                  iters = 0
+                  !!
+                  !! carbon dioxide (CO2); Jerry Blackford code (ostensibly OCMIP-2, but not)
+                  CALL trc_co2_medusa( ztmp, zsal, zdic, zalk, 0.0, f_kw660, f_xco2a,  &  ! inputs
+                  f_ph, f_pco2w, f_h2co3, f_hco3, f_co3, f_omcal(ji,jj),               &  ! outputs
+                  f_omarg(ji,jj), f_co2flux, f_TDIC, f_TALK, f_dcf, f_henry, iters )      ! outputs
+                  !!
+                  !! AXY (09/01/14): removed iteration and NaN checks; these have
+                  !!                 been moved to trc_co2_medusa together with a
+                  !!                 fudge that amends erroneous values (this is
+                  !!                 intended to be a temporary fudge!); the
+                  !!                 output warnings are retained here so that
+                  !!                 failure position can be determined
+                  if (iters .eq. 25) then
+                     IF(lwp) WRITE(numout,*) ' trc_bio_medusa: ITERS WARNING, ', &
+                     iters, ' AT (', ji, ', ', jj, ', ', jk, ') AT ', kt
+                  endif
+#   endif
+#  else
+                  !! AXY (18/04/13): switch off carbonate chemistry calculations; provide
+                  !!                 quasi-sensible alternatives
+                  f_ph           = 8.1
+                  f_pco2w        = f_xco2a
+                  f_h2co3        = 0.005 * zdic
+                  f_hco3         = 0.865 * zdic
+                  f_co3          = 0.130 * zdic
+                  f_omcal(ji,jj) = 4.
+                  f_omarg(ji,jj) = 2.
+                  f_co2flux      = 0.
+                  f_TDIC         = zdic
+                  f_TALK         = zalk
+                  f_dcf          = 1.026
+                  f_henry        = 1.
+                  !! AXY (23/06/15): add in some extra MOCSY diagnostics
+                  f_fco2w        = f_xco2a
+                  f_BetaD        = 1.
+                  f_rhosw        = 1.026
+                  f_opres        = 0.
+                  f_insitut      = ztmp
+                  f_pco2atm      = f_xco2a
+                  f_fco2atm      = f_xco2a
+                  f_schmidtco2   = 660.
+                  f_kwco2        = 0.
+                  f_K0           = 0.
+                  f_co2starair   = f_xco2a
+                  f_dpco2        = 0.
+#  endif
+                  !!
+                  !! mmol/m2/s -> mmol/m3/d; correct for sea-ice; divide through by layer thickness
+                  f_co2flux = (1. - fr_i(ji,jj)) * f_co2flux * 86400. / fthk
+                  !!
+                  !! oxygen (O2); OCMIP-2 code
+                  !! AXY (23/06/15): amend input list for oxygen to account for common gas
+                  !!                 transfer velocity
+                  !! CALL trc_oxy_medusa( ztmp, zsal, f_uwind, f_vwind, f_pp0, zoxy / 1000., fthk,  &  ! inputs
+                  !! f_kw660, f_o2flux, f_o2sat )                                                      ! outputs
+                  CALL trc_oxy_medusa( ztmp, zsal, f_kw660, f_pp0, zoxy,  &  ! inputs
+                  f_kwo2, f_o2flux, f_o2sat )                                ! outputs
+                  !!
+                  !! mmol/m2/s -> mol/m3/d; correct for sea-ice; divide through by layer thickness
+                  f_o2flux  = (1. - fr_i(ji,jj)) * f_o2flux * 86400. / fthk
+                  !!
+                  !! Jpalm (08-2014)
+                  !! DMS surface concentration calculation
+                  !! initialy added for UKESM1 model.
+                  !! using MET-OFFICE subroutine.
+                  !! DMS module only needs Chl concentration and MLD
+                  !! to get an aproximate value of DMS concentration.
+                  !! air-sea fluxes are calculated by atmospheric chemitry model
+                  !! from atm and oc-surface concentrations.
+                  !!
+                  !! AXY (13/03/15): this is amended to calculate all of the DMS
+                  !!                 estimates examined during UKESM1 (see comments
+                  !!                 in trcdms_medusa.F90)
+                  !!
+                  !! AXY (25/05/17): amended to additionally pass DIN limitation as well as [DIN];
+                  !!                 accounts for differences in nutrient half-saturations; changes
+                  !!                 also made in trc_dms_medusa; this permits an additional DMS
+                  !!                 calculation while retaining the existing Anderson one
+                  !!
+                  IF (jdms .eq. 1) THEN
+                     !!
+                     !! calculate weighted half-saturation for DIN uptake
+                     dms_wtkn = ((zphn * xnln) + (zphd * xnld)) / (zphn + zphd)
+                     !!
+                     !! feed in correct inputs
+                     if (jdms_input .eq. 0) then
+                        !! use instantaneous inputs
+                        dms_nlim = zdin / (zdin + dms_wtkn)
+                        !!
+                        CALL trc_dms_medusa( zchn, zchd,                           &  ! inputs
+                        hmld(ji,jj), qsr(ji,jj),                                   &  ! inputs
+                        zdin, dms_nlim,                                            &  ! inputs
+                        dms_andr, dms_simo, dms_aran, dms_hall, dms_andm )            ! outputs
+                     else
+                        !! use diel-average inputs
+                        dms_nlim = zn_dms_din(ji,jj) / (zn_dms_din(ji,jj) + dms_wtkn)
+                        !!
+                        CALL trc_dms_medusa( zn_dms_chn(ji,jj), zn_dms_chd(ji,jj), &  ! inputs
+                        zn_dms_mld(ji,jj), zn_dms_qsr(ji,jj),                      &  ! inputs
+                        zn_dms_din(ji,jj), dms_nlim,                               &  ! inputs
+                        dms_andr, dms_simo, dms_aran, dms_hall, dms_andm )            ! outputs
+                     endif
+                     !!
+                     !! assign correct output to variable passed to atmosphere
+                     if     (jdms_model .eq. 1) then
+                        dms_surf = dms_andr
+                     elseif (jdms_model .eq. 2) then
+                        dms_surf = dms_simo
+                     elseif (jdms_model .eq. 3) then
+                        dms_surf = dms_aran
+                     elseif (jdms_model .eq. 4) then
+                        dms_surf = dms_hall
+                     elseif (jdms_model .eq. 5) then
+                        dms_surf = dms_andm
+                     endif
+                     !!
+                     !! 2D diag through iom_use
+                     IF( lk_iomput ) THEN
+                       IF( med_diag%DMS_SURF%dgsave ) THEN
+                         dms_surf2d(ji,jj) = dms_surf
+                       ENDIF
+                       IF( med_diag%DMS_ANDR%dgsave ) THEN
+                         dms_andr2d(ji,jj) = dms_andr
+                       ENDIF
+                       IF( med_diag%DMS_SIMO%dgsave ) THEN
+                         dms_simo2d(ji,jj) = dms_simo
+                       ENDIF
+                       IF( med_diag%DMS_ARAN%dgsave ) THEN
+                         dms_aran2d(ji,jj) = dms_aran
+                       ENDIF
+                       IF( med_diag%DMS_HALL%dgsave ) THEN
+                         dms_hall2d(ji,jj) = dms_hall
+                       ENDIF
+                       IF( med_diag%DMS_ANDM%dgsave ) THEN
+                         dms_andm2d(ji,jj) = dms_andm
+                       ENDIF
+#   if defined key_debug_medusa
+                       IF (lwp) write (numout,*) 'trc_bio_medusa: finish calculating dms'
+                     CALL flush(numout)
+#   endif 
+                     ENDIF
+                     !! End iom
+                  ENDIF
+                  !! End DMS Loop
+                  !!
+                  !! store 2D outputs
+                  !!
+                  !! JPALM -- 17-11-16 -- put fgco2 out of diag request
+                  !!                    is needed for coupling; pass through restart
+                  !! IF( med_diag%FGCO2%dgsave ) THEN
+                     !! convert from  mol/m2/day to kg/m2/s
+                     fgco2(ji,jj) = f_co2flux * fthk * CO2flux_conv  !! mmol-C/m3/d -> kg-CO2/m2/s
+                  !! ENDIF
+                  IF ( lk_iomput ) THEN
+                      IF( med_diag%ATM_PCO2%dgsave ) THEN
+                         f_pco2a2d(ji,jj) = f_pco2atm
+                      ENDIF
+                      IF( med_diag%OCN_PCO2%dgsave ) THEN
+                         f_pco2w2d(ji,jj) = f_pco2w
+                      ENDIF
+                      IF( med_diag%CO2FLUX%dgsave ) THEN
+                         f_co2flux2d(ji,jj) = f_co2flux * fthk           !! mmol/m3/d -> mmol/m2/d
+                      ENDIF
+                      IF( med_diag%TCO2%dgsave ) THEN
+                         f_TDIC2d(ji,jj) = f_TDIC
+                      ENDIF
+                      IF( med_diag%TALK%dgsave ) THEN
+                         f_TALK2d(ji,jj) = f_TALK
+                      ENDIF
+                      IF( med_diag%KW660%dgsave ) THEN
+                         f_kw6602d(ji,jj) = f_kw660
+                      ENDIF
+                      IF( med_diag%ATM_PP0%dgsave ) THEN
+                         f_pp02d(ji,jj) = f_pp0
+                      ENDIF
+                      IF( med_diag%O2FLUX%dgsave ) THEN
+                         f_o2flux2d(ji,jj) = f_o2flux
+                      ENDIF
+                      IF( med_diag%O2SAT%dgsave ) THEN
+                         f_o2sat2d(ji,jj) = f_o2sat
+                      ENDIF
+                      !! AXY (24/11/16): add in extra MOCSY diagnostics
+                      IF( med_diag%ATM_XCO2%dgsave ) THEN
+                         f_xco2a_2d(ji,jj) = f_xco2a
+                      ENDIF
+                      IF( med_diag%OCN_FCO2%dgsave ) THEN
+                         f_fco2w_2d(ji,jj) = f_fco2w
+                      ENDIF
+                      IF( med_diag%ATM_FCO2%dgsave ) THEN
+                         f_fco2a_2d(ji,jj) = f_fco2atm
+                      ENDIF
+                      IF( med_diag%OCN_RHOSW%dgsave ) THEN
+                         f_ocnrhosw_2d(ji,jj) = f_rhosw
+                      ENDIF
+                      IF( med_diag%OCN_SCHCO2%dgsave ) THEN
+                         f_ocnschco2_2d(ji,jj) = f_schmidtco2
+                      ENDIF
+                      IF( med_diag%OCN_KWCO2%dgsave ) THEN
+                         f_ocnkwco2_2d(ji,jj) = f_kwco2
+                      ENDIF
+                      IF( med_diag%OCN_K0%dgsave ) THEN
+                         f_ocnk0_2d(ji,jj) = f_K0
+                      ENDIF
+                      IF( med_diag%CO2STARAIR%dgsave ) THEN
+                         f_co2starair_2d(ji,jj) = f_co2starair
+                      ENDIF
+                      IF( med_diag%OCN_DPCO2%dgsave ) THEN
+                         f_ocndpco2_2d(ji,jj) = f_dpco2
+                      ENDIF
+                  ENDIF
+                  !! 
+               endif
+               !! End jk = 1 loop within ROAM key 
+
+               !! AXY (11/11/16): CMIP6 oxygen saturation 3D diagnostic
+               IF ( med_diag%O2SAT3%dgsave ) THEN
+                  call oxy_sato( ztmp, zsal, f_o2sat3 )
+                  o2sat3(ji, jj, jk) = f_o2sat3
+               ENDIF
+
+# endif
+
+               if ( jk .eq. 1 ) then
+                  !!----------------------------------------------------------------------
+                  !! River inputs
+                  !!----------------------------------------------------------------------
+                  !!
+                  !! runoff comes in as        kg / m2 / s
+                  !! used and written out as   m3 / m2 / d (= m / d)
+                  !! where                     1000 kg / m2 / d = 1 m3 / m2 / d = 1 m / d
+                  !!
+                  !! AXY (17/07/14): the compiler doesn't like this line for some reason;
+                  !!                 as MEDUSA doesn't even use runoff for riverine inputs,
+                  !!                 a temporary solution is to switch off runoff entirely
+                  !!                 here; again, this change is one of several that will 
+                  !!                 need revisiting once MEDUSA has bedded down in UKESM1;
+                  !!                 particularly so if the land scheme provides information
+                  !!                 concerning nutrient fluxes
+                  !!
+                  !! f_runoff(ji,jj) = sf_rnf(1)%fnow(ji,jj,1) / 1000. * 60. * 60. * 24.
+                  f_runoff(ji,jj) = 0.0
+                  !!
+                  !! nutrients are added via rivers to the model in one of two ways:
+                  !!   1. via river concentration; i.e. the average nutrient concentration
+                  !!      of a river water is described by a spatial file, and this is
+                  !!      multiplied by runoff to give a nutrient flux
+                  !!   2. via direct river flux; i.e. the average nutrient flux due to
+                  !!      rivers is described by a spatial file, and this is simply applied
+                  !!      as a direct nutrient flux (i.e. it does not relate or respond to
+                  !!      model runoff)
+                  !! nutrient fields are derived from the GlobalNEWS 2 database; carbon and
+                  !! alkalinity are derived from continent-scale DIC estimates (Huang et al., 
+                  !! 2012) and some Arctic river alkalinity estimates (Katya?)
+                  !! 
+                  !! as of 19/07/12, riverine nutrients can now be spread vertically across 
+                  !! several grid cells rather than just poured into the surface box; this
+                  !! block of code is still executed, however, to set up the total amounts
+                  !! of nutrient entering via rivers
+                  !!
+                  !! nitrogen
+                  if (jriver_n .eq. 1) then
+                     !! river concentration specified; use runoff to calculate input
+                     f_riv_n(ji,jj) = f_runoff(ji,jj) * riv_n(ji,jj)
+                  elseif (jriver_n .eq. 2) then
+                     !! river flux specified; independent of runoff
+                     f_riv_n(ji,jj) = riv_n(ji,jj)
+                  endif
+                  !!
+                  !! silicon
+                  if (jriver_si .eq. 1) then
+                     !! river concentration specified; use runoff to calculate input
+                     f_riv_si(ji,jj) = f_runoff(ji,jj) * riv_si(ji,jj)
+                  elseif (jriver_si .eq. 2) then
+                     !! river flux specified; independent of runoff
+                     f_riv_si(ji,jj) = riv_si(ji,jj)
+                  endif
+                  !!
+                  !! carbon
+                  if (jriver_c .eq. 1) then
+                     !! river concentration specified; use runoff to calculate input
+                     f_riv_c(ji,jj) = f_runoff(ji,jj) * riv_c(ji,jj)
+                  elseif (jriver_c .eq. 2) then
+                     !! river flux specified; independent of runoff
+                     f_riv_c(ji,jj) = riv_c(ji,jj)
+                  endif
+                  !!
+                  !! alkalinity
+                  if (jriver_alk .eq. 1) then
+                     !! river concentration specified; use runoff to calculate input
+                     f_riv_alk(ji,jj) = f_runoff(ji,jj) * riv_alk(ji,jj)
+                  elseif (jriver_alk .eq. 2) then
+                     !! river flux specified; independent of runoff
+                     f_riv_alk(ji,jj) = riv_alk(ji,jj)
+                  endif
+
+               endif
+
+               !!----------------------------------------------------------------------
+               !! Chlorophyll calculations
+               !!----------------------------------------------------------------------
+               !!
+               !! non-diatoms
+	       if (zphn.GT.rsmall) then
+                  fthetan = max(tiny(zchn), (zchn * xxi) / (zphn + tiny(zphn)))
+                  faln    = xaln * fthetan
+               else
+                  fthetan = 0.
+                  faln    = 0.
+               endif
+               !!
+               !! diatoms
+	       if (zphd.GT.rsmall) then
+                  fthetad = max(tiny(zchd), (zchd * xxi) / (zphd + tiny(zphd)))
+                  fald    = xald * fthetad
+               else
+                  fthetad = 0.
+                  fald    = 0.
+               endif
+
+# if defined key_debug_medusa
+               !! report biological calculations
+               if (idf.eq.1.AND.idfval.eq.1) then
+                  IF (lwp) write (numout,*) '------------------------------'
+                  IF (lwp) write (numout,*) 'faln(',jk,') = ', faln
+                  IF (lwp) write (numout,*) 'fald(',jk,') = ', fald
+               endif
+# endif
+
+               !!----------------------------------------------------------------------
+               !! Phytoplankton light limitation
+               !!----------------------------------------------------------------------
+               !!
+               !! It is assumed xpar is the depth-averaged (vertical layer) PAR 
+               !! Light limitation (check self-shading) in W/m2
+               !!
+               !! Note that there is no temperature dependence in phytoplankton
+               !! growth rate or any other function. 
+               !! In calculation of Chl/Phy ratio tiny(phyto) is introduced to avoid
+               !! NaNs in case of Phy==0.  
+               !!
+               !! fthetad and fthetan are Chl:C ratio (gChl/gC) in diat and non-diat: 
+               !! for 1:1 Chl:P ratio (mgChl/mmolN) theta=0.012
+               !!
+               !! AXY (16/07/09)
+               !! temperature for new Eppley style phytoplankton growth
+               loc_T   = tsn(ji,jj,jk,jp_tem)
+               fun_T   = 1.066**(1.0 * loc_T)
+               !! AXY (16/05/11): add in new Q10 (1.5, not 2.0) for
+               !phytoplankton
+               !!                 growth; remin. unaffected
+               fun_Q10 = jq10**((loc_T - 0.0) / 10.0)
+               if (jphy.eq.1) then
+                  xvpnT = xvpn * fun_T
+                  xvpdT = xvpd * fun_T
+               elseif (jphy.eq.2) then
+                  xvpnT = xvpn * fun_Q10
+                  xvpdT = xvpd * fun_Q10
+               else
+                  xvpnT = xvpn
+                  xvpdT = xvpd
+               endif
+               !!
+               !! non-diatoms
+               fchn1   = (xvpnT * xvpnT) + (faln * faln * xpar(ji,jj,jk) * xpar(ji,jj,jk))
+               if (fchn1.GT.rsmall) then
+                  fchn    = xvpnT / (sqrt(fchn1) + tiny(fchn1))
+               else
+                  fchn    = 0.
+               endif
+               fjln    = fchn * faln * xpar(ji,jj,jk) !! non-diatom J term
+               fjlim_pn = fjln / xvpnT
+               !!
+               !! diatoms
+               fchd1   = (xvpdT * xvpdT) + (fald * fald * xpar(ji,jj,jk) * xpar(ji,jj,jk))
+               if (fchd1.GT.rsmall) then
+                  fchd    = xvpdT / (sqrt(fchd1) + tiny(fchd1))
+               else
+                  fchd    = 0.
+               endif
+               fjld    = fchd * fald * xpar(ji,jj,jk) !! diatom J term
+               fjlim_pd = fjld / xvpdT
+      
+# if defined key_debug_medusa
+               !! report phytoplankton light limitation
+               if (idf.eq.1.AND.idfval.eq.1) then
+                  IF (lwp) write (numout,*) '------------------------------'
+                  IF (lwp) write (numout,*) 'fchn(',jk,') = ', fchn
+                  IF (lwp) write (numout,*) 'fchd(',jk,') = ', fchd
+                  IF (lwp) write (numout,*) 'fjln(',jk,') = ', fjln
+                  IF (lwp) write (numout,*) 'fjld(',jk,') = ', fjld
+               endif
+# endif
+
+               !!----------------------------------------------------------------------
+               !! Phytoplankton nutrient limitation
+               !!----------------------------------------------------------------------
+               !!
+               !! non-diatoms (N, Fe)
+               fnln = zdin / (zdin + xnln) !! non-diatom Qn term
+               ffln = zfer / (zfer + xfln) !! non-diatom Qf term
+               !!
+               !! diatoms (N, Si, Fe)
+               fnld = zdin / (zdin + xnld) !! diatom Qn term
+               fsld = zsil / (zsil + xsld) !! diatom Qs term
+               ffld = zfer / (zfer + xfld) !! diatom Qf term
+
+# if defined key_debug_medusa
+               !! report phytoplankton nutrient limitation
+               if (idf.eq.1.AND.idfval.eq.1) then
+                  IF (lwp) write (numout,*) '------------------------------'
+                  IF (lwp) write (numout,*) 'fnln(',jk,') = ', fnln
+                  IF (lwp) write (numout,*) 'fnld(',jk,') = ', fnld
+                  IF (lwp) write (numout,*) 'ffln(',jk,') = ', ffln
+                  IF (lwp) write (numout,*) 'ffld(',jk,') = ', ffld
+                  IF (lwp) write (numout,*) 'fsld(',jk,') = ', fsld
+               endif
+# endif
+
+               !!----------------------------------------------------------------------
+               !! Primary production (non-diatoms)
+               !! (note: still needs multiplying by phytoplankton concentration)
+               !!----------------------------------------------------------------------
+               !!
+               if (jliebig .eq. 0) then
+                  !! multiplicative nutrient limitation
+                  fpnlim = fnln * ffln
+               elseif (jliebig .eq. 1) then
+                  !! Liebig Law (= most limiting) nutrient limitation
+                  fpnlim = min(fnln, ffln)
+               endif
+               fprn = fjln * fpnlim
+
+               !!----------------------------------------------------------------------
+               !! Primary production (diatoms)
+               !! (note: still needs multiplying by phytoplankton concentration)
+               !!
+               !! production here is split between nitrogen production and that of
+               !! silicon; depending upon the "intracellular" ratio of Si:N, model
+               !! diatoms will uptake nitrogen/silicon differentially; this borrows
+               !! from the diatom model of Mongin et al. (2006)
+               !!----------------------------------------------------------------------
+               !!
+               if (jliebig .eq. 0) then
+                  !! multiplicative nutrient limitation
+                  fpdlim = fnld * ffld
+               elseif (jliebig .eq. 1) then
+                  !! Liebig Law (= most limiting) nutrient limitation
+                  fpdlim = min(fnld, ffld)
+               endif
+               !!
+	       if (zphd.GT.rsmall .AND. zpds.GT.rsmall) then
+                  !! "intracellular" elemental ratios
+                  ! fsin  = zpds / (zphd + tiny(zphd))
+                  ! fnsi  = zphd / (zpds + tiny(zpds))
+                  fsin = 0.0
+                  IF( zphd .GT. rsmall) fsin  = zpds / zphd
+                  fnsi = 0.0
+                  IF( zpds .GT. rsmall) fnsi  = zphd / zpds
+                  !! AXY (23/02/10): these next variables derive from Mongin et al. (2003)
+                  fsin1 = 3.0 * xsin0 !! = 0.6
+                  fnsi1 = 1.0 / fsin1 !! = 1.667
+                  fnsi2 = 1.0 / xsin0 !! = 5.0
+                  !!
+                  !! conditionalities based on ratios
+                  !! nitrogen (and iron and carbon)
+                  if (fsin.le.xsin0) then
+                     fprd  = 0.0
+                     fsld2 = 0.0
+                  elseif (fsin.lt.fsin1) then
+                     fprd  = xuif * ((fsin - xsin0) / (fsin + tiny(fsin))) * (fjld * fpdlim)
+                     fsld2 = xuif * ((fsin - xsin0) / (fsin + tiny(fsin)))
+                  elseif (fsin.ge.fsin1) then
+                     fprd  = (fjld * fpdlim)
+                     fsld2 = 1.0
+                  endif
+                  !!
+                  !! silicon
+                  if (fsin.lt.fnsi1) then
+                     fprds = (fjld * fsld)
+                  elseif (fsin.lt.fnsi2) then
+                     fprds = xuif * ((fnsi - xnsi0) / (fnsi + tiny(fnsi))) * (fjld * fsld)
+                  else
+                     fprds = 0.0
+                  endif     
+               else
+                  fsin  = 0.0
+                  fnsi  = 0.0
+                  fprd  = 0.0
+                  fsld2 = 0.0
+                  fprds = 0.0
+               endif
+
+# if defined key_debug_medusa
+               !! report phytoplankton growth (including diatom silicon submodel)
+               if (idf.eq.1.AND.idfval.eq.1) then
+                  IF (lwp) write (numout,*) '------------------------------'
+                  IF (lwp) write (numout,*) 'fsin(',jk,')   = ', fsin
+                  IF (lwp) write (numout,*) 'fnsi(',jk,')   = ', fnsi
+                  IF (lwp) write (numout,*) 'fsld2(',jk,')  = ', fsld2
+                  IF (lwp) write (numout,*) 'fprn(',jk,')   = ', fprn
+                  IF (lwp) write (numout,*) 'fprd(',jk,')   = ', fprd
+                  IF (lwp) write (numout,*) 'fprds(',jk,')  = ', fprds
+               endif
+# endif
+
+               !!----------------------------------------------------------------------
+               !! Mixed layer primary production
+               !! this block calculates the amount of primary production that occurs
+               !! within the upper mixed layer; this allows the separate diagnosis
+               !! of "sub-surface" primary production; it does assume that short-
+               !! term variability in mixed layer depth doesn't mess with things
+               !! though
+               !!----------------------------------------------------------------------
+               !!
+               if (fdep1.le.hmld(ji,jj)) then
+                  !! this level is entirely in the mixed layer
+                  fq0 = 1.0
+               elseif (fdep.ge.hmld(ji,jj)) then
+                  !! this level is entirely below the mixed layer
+                  fq0 = 0.0
+               else
+                  !! this level straddles the mixed layer
+                  fq0 = (hmld(ji,jj) - fdep) / fthk
+               endif
+               !!
+               fprn_ml(ji,jj) = fprn_ml(ji,jj) + (fprn * zphn * fthk * fq0)
+               fprd_ml(ji,jj) = fprd_ml(ji,jj) + (fprd * zphd * fthk * fq0)
+               
+               !!----------------------------------------------------------------------
+               !! Vertical Integral --
+               !!----------------------------------------------------------------------
+               ftot_pn(ji,jj)  = ftot_pn(ji,jj)  + (zphn * fthk)   !! vertical integral non-diatom phytoplankton
+               ftot_pd(ji,jj)  = ftot_pd(ji,jj)  + (zphd * fthk)   !! vertical integral diatom phytoplankton
+               ftot_zmi(ji,jj) = ftot_zmi(ji,jj) + (zzmi * fthk)   !! vertical integral microzooplankton
+               ftot_zme(ji,jj) = ftot_zme(ji,jj) + (zzme * fthk)   !! vertical integral mesozooplankton
+               ftot_det(ji,jj) = ftot_det(ji,jj) + (zdet * fthk)   !! vertical integral slow detritus, nitrogen
+               ftot_dtc(ji,jj) = ftot_dtc(ji,jj) + (zdtc * fthk)   !! vertical integral slow detritus, carbon
+               
+               !!----------------------------------------------------------------------
+               !! More chlorophyll calculations
+               !!----------------------------------------------------------------------
+               !!
+               !! frn = (xthetam / fthetan) * (fprn / (fthetan * xpar(ji,jj,jk)))
+               !! frd = (xthetam / fthetad) * (fprd / (fthetad * xpar(ji,jj,jk)))
+               frn = (xthetam * fchn * fnln * ffln       ) / (fthetan + tiny(fthetan))
+               !! AXY (12/05/09): there's potentially a problem here; fsld, silicic acid 
+               !!   limitation, is used in the following line to regulate chlorophyll 
+               !!   growth in a manner that is inconsistent with its use in the regulation 
+               !!   of biomass growth; the Mongin term term used in growth is more complex
+               !!   than the simple multiplicative function used below
+               !! frd = (xthetam * fchd * fnld * ffld * fsld) / (fthetad + tiny(fthetad))
+               !! AXY (12/05/09): this replacement line uses the new variable, fsld2, to
+               !!   regulate chlorophyll growth
+               frd = (xthetamd * fchd * fnld * ffld * fsld2) / (fthetad + tiny(fthetad))
+
+# if defined key_debug_medusa
+               !! report chlorophyll calculations
+               if (idf.eq.1.AND.idfval.eq.1) then
+                  IF (lwp) write (numout,*) '------------------------------'
+                  IF (lwp) write (numout,*) 'fthetan(',jk,') = ', fthetan
+                  IF (lwp) write (numout,*) 'fthetad(',jk,') = ', fthetad
+                  IF (lwp) write (numout,*) 'frn(',jk,')     = ', frn
+                  IF (lwp) write (numout,*) 'frd(',jk,')     = ', frd
+               endif
+# endif
+
+               !!----------------------------------------------------------------------
+               !! Zooplankton Grazing 
+               !! this code supplements the base grazing model with one that
+               !! considers the C:N ratio of grazed food and balances this against
+               !! the requirements of zooplankton growth; this model is derived 
+               !! from that of Anderson & Pondaven (2003)
+               !!
+               !! the current version of the code assumes a fixed C:N ratio for
+               !! detritus (in contrast to Anderson & Pondaven, 2003), though the
+               !! full equations are retained for future extension
+               !!----------------------------------------------------------------------
+               !!
+               !!----------------------------------------------------------------------
+               !! Microzooplankton first
+               !!----------------------------------------------------------------------
+               !!
+               fmi1    = (xkmi * xkmi) + (xpmipn * zphn * zphn) + (xpmid * zdet * zdet)
+               fmi     = xgmi * zzmi / fmi1
+               fgmipn  = fmi * xpmipn * zphn * zphn   !! grazing on non-diatoms
+               fgmid   = fmi * xpmid  * zdet * zdet   !! grazing on detrital nitrogen
+# if defined key_roam
+               fgmidc  = rsmall !acc
+               IF ( zdet .GT. rsmall ) fgmidc  = (zdtc / (zdet + tiny(zdet))) * fgmid  !! grazing on detrital carbon
+# else
+               !! AXY (26/11/08): implicit detrital carbon change
+               fgmidc  = xthetad * fgmid              !! grazing on detrital carbon
+# endif
+               !!
+               !! which translates to these incoming N and C fluxes
+               finmi   = (1.0 - xphi) * (fgmipn + fgmid)
+               ficmi   = (1.0 - xphi) * ((xthetapn * fgmipn) + fgmidc)
+               !!
+               !! the ideal food C:N ratio for microzooplankton
+               !! xbetan = 0.77; xthetaz = 5.625; xbetac = 0.64; xkc = 0.80
+               fstarmi = (xbetan * xthetazmi) / (xbetac * xkc)
+               !!
+               !! process these to determine proportioning of grazed N and C
+               !! (since there is no explicit consideration of respiration,
+               !! only growth and excretion are calculated here)
+               fmith   = (ficmi / (finmi + tiny(finmi)))
+               if (fmith.ge.fstarmi) then
+                  fmigrow = xbetan * finmi
+                  fmiexcr = 0.0
+               else
+                  fmigrow = (xbetac * xkc * ficmi) / xthetazmi
+                  fmiexcr = ficmi * ((xbetan / (fmith + tiny(fmith))) - ((xbetac * xkc) / xthetazmi))
+               endif
+# if defined key_roam
+               fmiresp = (xbetac * ficmi) - (xthetazmi * fmigrow)
+# endif
+
+# if defined key_debug_medusa
+               !! report microzooplankton grazing
+               if (idf.eq.1.AND.idfval.eq.1) then
+                  IF (lwp) write (numout,*) '------------------------------'
+                  IF (lwp) write (numout,*) 'fmi1(',jk,')    = ', fmi1
+                  IF (lwp) write (numout,*) 'fmi(',jk,')     = ', fmi
+                  IF (lwp) write (numout,*) 'fgmipn(',jk,')  = ', fgmipn
+                  IF (lwp) write (numout,*) 'fgmid(',jk,')   = ', fgmid
+                  IF (lwp) write (numout,*) 'fgmidc(',jk,')  = ', fgmidc
+                  IF (lwp) write (numout,*) 'finmi(',jk,')   = ', finmi
+                  IF (lwp) write (numout,*) 'ficmi(',jk,')   = ', ficmi
+                  IF (lwp) write (numout,*) 'fstarmi(',jk,') = ', fstarmi
+                  IF (lwp) write (numout,*) 'fmith(',jk,')   = ', fmith
+                  IF (lwp) write (numout,*) 'fmigrow(',jk,') = ', fmigrow
+                  IF (lwp) write (numout,*) 'fmiexcr(',jk,') = ', fmiexcr
+#  if defined key_roam
+                  IF (lwp) write (numout,*) 'fmiresp(',jk,') = ', fmiresp
+#  endif
+               endif
+# endif
+
+               !!----------------------------------------------------------------------
+               !! Mesozooplankton second
+               !!----------------------------------------------------------------------
+               !!
+               fme1    = (xkme * xkme) + (xpmepn * zphn * zphn) + (xpmepd * zphd * zphd) + & 
+                         (xpmezmi * zzmi * zzmi) + (xpmed * zdet * zdet)
+               fme     = xgme * zzme / fme1
+               fgmepn  = fme * xpmepn  * zphn * zphn  !! grazing on non-diatoms
+               fgmepd  = fme * xpmepd  * zphd * zphd  !! grazing on diatoms
+               fgmepds = fsin * fgmepd                !! grazing on diatom silicon
+               fgmezmi = fme * xpmezmi * zzmi * zzmi  !! grazing on microzooplankton
+               fgmed   = fme * xpmed   * zdet * zdet  !! grazing on detrital nitrogen
+# if defined key_roam
+               fgmedc  = rsmall !acc
+               IF ( zdet .GT. rsmall ) fgmedc  = (zdtc / (zdet + tiny(zdet))) * fgmed  !! grazing on detrital carbon
+# else
+               !! AXY (26/11/08): implicit detrital carbon change
+               fgmedc  = xthetad * fgmed              !! grazing on detrital carbon
+# endif
+               !!
+               !! which translates to these incoming N and C fluxes
+               finme   = (1.0 - xphi) * (fgmepn + fgmepd + fgmezmi + fgmed)
+               ficme   = (1.0 - xphi) * ((xthetapn * fgmepn) + (xthetapd * fgmepd) + &
+                        (xthetazmi * fgmezmi) + fgmedc)
+               !!
+               !! the ideal food C:N ratio for mesozooplankton
+               !! xbetan = 0.77; xthetaz = 5.625; xbetac = 0.64; xkc = 0.80
+               fstarme = (xbetan * xthetazme) / (xbetac * xkc)
+               !!
+               !! process these to determine proportioning of grazed N and C
+               !! (since there is no explicit consideration of respiration,
+               !! only growth and excretion are calculated here)
+               fmeth   = (ficme / (finme + tiny(finme)))
+               if (fmeth.ge.fstarme) then
+                  fmegrow = xbetan * finme
+                  fmeexcr = 0.0
+               else
+                  fmegrow = (xbetac * xkc * ficme) / xthetazme
+                  fmeexcr = ficme * ((xbetan / (fmeth + tiny(fmeth))) - ((xbetac * xkc) / xthetazme))
+               endif
+# if defined key_roam
+               fmeresp = (xbetac * ficme) - (xthetazme * fmegrow)
+# endif
+
+# if defined key_debug_medusa
+               !! report mesozooplankton grazing
+               if (idf.eq.1.AND.idfval.eq.1) then
+                  IF (lwp) write (numout,*) '------------------------------'
+                  IF (lwp) write (numout,*) 'fme1(',jk,')    = ', fme1
+                  IF (lwp) write (numout,*) 'fme(',jk,')     = ', fme
+                  IF (lwp) write (numout,*) 'fgmepn(',jk,')  = ', fgmepn
+                  IF (lwp) write (numout,*) 'fgmepd(',jk,')  = ', fgmepd
+                  IF (lwp) write (numout,*) 'fgmepds(',jk,') = ', fgmepds
+                  IF (lwp) write (numout,*) 'fgmezmi(',jk,') = ', fgmezmi
+                  IF (lwp) write (numout,*) 'fgmed(',jk,')   = ', fgmed
+                  IF (lwp) write (numout,*) 'fgmedc(',jk,')  = ', fgmedc
+                  IF (lwp) write (numout,*) 'finme(',jk,')   = ', finme
+                  IF (lwp) write (numout,*) 'ficme(',jk,')   = ', ficme
+                  IF (lwp) write (numout,*) 'fstarme(',jk,') = ', fstarme
+                  IF (lwp) write (numout,*) 'fmeth(',jk,')   = ', fmeth
+                  IF (lwp) write (numout,*) 'fmegrow(',jk,') = ', fmegrow
+                  IF (lwp) write (numout,*) 'fmeexcr(',jk,') = ', fmeexcr
+#  if defined key_roam
+                  IF (lwp) write (numout,*) 'fmeresp(',jk,') = ', fmeresp
+#  endif
+               endif
+# endif
+
+               fzmi_i(ji,jj)  = fzmi_i(ji,jj)  + fthk * (  &
+                  fgmipn + fgmid )
+               fzmi_o(ji,jj)  = fzmi_o(ji,jj)  + fthk * (  &
+                  fmigrow + (xphi * (fgmipn + fgmid)) + fmiexcr + ((1.0 - xbetan) * finmi) )
+               fzme_i(ji,jj)  = fzme_i(ji,jj)  + fthk * (  &
+                  fgmepn + fgmepd + fgmezmi + fgmed )
+               fzme_o(ji,jj)  = fzme_o(ji,jj)  + fthk * (  &
+                  fmegrow + (xphi * (fgmepn + fgmepd + fgmezmi + fgmed)) + fmeexcr + ((1.0 - xbetan) * finme) )
+
+               !!----------------------------------------------------------------------
+               !! Plankton metabolic losses
+               !! Linear loss processes assumed to be metabolic in origin
+               !!----------------------------------------------------------------------
+               !!
+               fdpn2  = xmetapn  * zphn
+               fdpd2  = xmetapd  * zphd
+               fdpds2 = xmetapd  * zpds
+               fdzmi2 = xmetazmi * zzmi
+               fdzme2 = xmetazme * zzme
+
+               !!----------------------------------------------------------------------
+               !! Plankton mortality losses
+               !! EKP (26/02/09): phytoplankton hyperbolic mortality term introduced 
+               !! to improve performance in gyres
+               !!----------------------------------------------------------------------
+               !!
+               !! non-diatom phytoplankton
+               if (jmpn.eq.1) fdpn = xmpn * zphn               !! linear
+               if (jmpn.eq.2) fdpn = xmpn * zphn * zphn        !! quadratic
+               if (jmpn.eq.3) fdpn = xmpn * zphn * &           !! hyperbolic
+                  (zphn / (xkphn + zphn))
+               if (jmpn.eq.4) fdpn = xmpn * zphn * &           !! sigmoid
+                  ((zphn * zphn) / (xkphn + (zphn * zphn)))
+               !!
+               !! diatom phytoplankton
+               if (jmpd.eq.1) fdpd = xmpd * zphd               !! linear
+               if (jmpd.eq.2) fdpd = xmpd * zphd * zphd        !! quadratic
+               if (jmpd.eq.3) fdpd = xmpd * zphd * &           !! hyperbolic
+                  (zphd / (xkphd + zphd))
+               if (jmpd.eq.4) fdpd = xmpd * zphd * &           !! sigmoid
+                  ((zphd * zphd) / (xkphd + (zphd * zphd)))
+               fdpds = fdpd * fsin
+               !!
+               !! microzooplankton
+               if (jmzmi.eq.1) fdzmi = xmzmi * zzmi            !! linear
+               if (jmzmi.eq.2) fdzmi = xmzmi * zzmi * zzmi     !! quadratic
+               if (jmzmi.eq.3) fdzmi = xmzmi * zzmi * &        !! hyperbolic
+                  (zzmi / (xkzmi + zzmi))
+               if (jmzmi.eq.4) fdzmi = xmzmi * zzmi * &        !! sigmoid
+                  ((zzmi * zzmi) / (xkzmi + (zzmi * zzmi)))
+               !!
+               !! mesozooplankton
+               if (jmzme.eq.1) fdzme = xmzme * zzme            !! linear
+               if (jmzme.eq.2) fdzme = xmzme * zzme * zzme     !! quadratic
+               if (jmzme.eq.3) fdzme = xmzme * zzme * &        !! hyperbolic
+                  (zzme / (xkzme + zzme))
+               if (jmzme.eq.4) fdzme = xmzme * zzme * &        !! sigmoid
+                  ((zzme * zzme) / (xkzme + (zzme * zzme)))
+
+               !!----------------------------------------------------------------------
+               !! Detritus remineralisation
+               !! Constant or temperature-dependent
+               !!----------------------------------------------------------------------
+               !!
+               if (jmd.eq.1) then
+                  !! temperature-dependent
+                  fdd  = xmd  * fun_T * zdet
+# if defined key_roam
+                  fddc = xmdc * fun_T * zdtc
+# endif
+               elseif (jmd.eq.2) then
+                  !! AXY (16/05/13): add in Q10-based parameterisation (def in nmlst)
+                  !! temperature-dependent
+                  fdd  = xmd  * fun_Q10 * zdet
+# if defined key_roam
+                  fddc = xmdc * fun_Q10 * zdtc
+# endif
+               else
+                  !! temperature-independent
+                  fdd  = xmd  * zdet
+# if defined key_roam
+                  fddc = xmdc * zdtc
+# endif
+               endif
+               !!
+               !! AXY (22/07/09): accelerate detrital remineralisation in the bottom box
+               if ((jk.eq.jmbathy) .and. jsfd.eq.1) then
+                  fdd  = 1.0  * zdet
+# if defined key_roam
+                  fddc = 1.0  * zdtc
+# endif
+               endif
+               
+# if defined key_debug_medusa
+               !! report plankton mortality and remineralisation
+               if (idf.eq.1.AND.idfval.eq.1) then
+                  IF (lwp) write (numout,*) '------------------------------'
+                  IF (lwp) write (numout,*) 'fdpn2(',jk,') = ', fdpn2
+                  IF (lwp) write (numout,*) 'fdpd2(',jk,') = ', fdpd2
+                  IF (lwp) write (numout,*) 'fdpds2(',jk,')= ', fdpds2
+                  IF (lwp) write (numout,*) 'fdzmi2(',jk,')= ', fdzmi2
+                  IF (lwp) write (numout,*) 'fdzme2(',jk,')= ', fdzme2
+                  IF (lwp) write (numout,*) 'fdpn(',jk,')  = ', fdpn
+                  IF (lwp) write (numout,*) 'fdpd(',jk,')  = ', fdpd
+                  IF (lwp) write (numout,*) 'fdpds(',jk,') = ', fdpds
+                  IF (lwp) write (numout,*) 'fdzmi(',jk,') = ', fdzmi
+                  IF (lwp) write (numout,*) 'fdzme(',jk,') = ', fdzme
+                  IF (lwp) write (numout,*) 'fdd(',jk,')   = ', fdd
+#  if defined key_roam
+                  IF (lwp) write (numout,*) 'fddc(',jk,')  = ', fddc
+#  endif
+               endif
+# endif
+
+               !!----------------------------------------------------------------------
+               !! Detritus addition to benthos
+               !! If activated, slow detritus in the bottom box will enter the
+               !! benthic pool
+               !!----------------------------------------------------------------------
+               !!
+               if ((jk.eq.jmbathy) .and. jorgben.eq.1) then
+                  !! this is the BOTTOM OCEAN BOX -> into the benthic pool!
+                  !!
+                  f_sbenin_n(ji,jj)  = (zdet * vsed * 86400.)
+                  f_sbenin_fe(ji,jj) = (zdet * vsed * 86400. * xrfn)
+# if defined key_roam
+                  f_sbenin_c(ji,jj)  = (zdtc * vsed * 86400.)
+# else
+                  f_sbenin_c(ji,jj)  = (zdet * vsed * 86400. * xthetad)
+# endif
+               endif
+
+               !!----------------------------------------------------------------------
+               !! Iron chemistry and fractionation
+               !! following the Parekh et al. (2004) scheme adopted by the Met.
+               !! Office, Medusa models total iron but considers "free" and
+               !! ligand-bound forms for the purposes of scavenging (only "free"
+               !! iron can be scavenged
+               !!----------------------------------------------------------------------
+               !!
+               !! total iron concentration (mmol Fe / m3 -> umol Fe / m3)
+               xFeT        = zfer * 1.e3
+               !!
+               !! calculate fractionation (based on Diat-HadOCC; in turn based on Parekh et al., 2004)
+               xb_coef_tmp = xk_FeL * (xLgT - xFeT) - 1.0
+               xb2M4ac     = max(((xb_coef_tmp * xb_coef_tmp) + (4.0 * xk_FeL * xLgT)), 0.0)
+               !!
+               !! "free" ligand concentration
+               xLgF        = 0.5 * (xb_coef_tmp + (xb2M4ac**0.5)) / xk_FeL
+               !!
+               !! ligand-bound iron concentration
+               xFeL        = xLgT - xLgF
+               !!
+               !! "free" iron concentration (and convert to mmol Fe / m3)
+               xFeF        = (xFeT - xFeL) * 1.e-3
+               xFree(ji,jj)= xFeF / (zfer + tiny(zfer))
+               !!
+               !! scavenging of iron (multiple schemes); I'm only really happy with the 
+               !! first one at the moment - the others involve assumptions (sometimes
+               !! guessed at by me) that are potentially questionable
+               !!
+               if (jiron.eq.1) then
+                  !!----------------------------------------------------------------------
+                  !! Scheme 1: Dutkiewicz et al. (2005)
+                  !! This scheme includes a single scavenging term based solely on a
+                  !! fixed rate and the availablility of "free" iron
+                  !!----------------------------------------------------------------------
+                  !!
+                  ffescav     = xk_sc_Fe * xFeF                     ! = mmol/m3/d
+                  !!
+                  !!----------------------------------------------------------------------
+                  !!
+                  !! Mick's code contains a further (optional) implicit "scavenging" of 
+                  !! iron that sets an upper bound on "free" iron concentration, and 
+                  !! essentially caps the concentration of total iron as xFeL + "free" 
+                  !! iron; since the former is constrained by a fixed total ligand 
+                  !! concentration (= 1.0 umol/m3), and the latter isn't allowed above 
+                  !! this upper bound, total iron is constrained to a maximum of ...
+                  !!
+                  !!    xFeL + min(xFeF, 0.3 umol/m3) = 1.0 + 0.3 = 1.3 umol / m3
+                  !! 
+                  !! In Mick's code, the actual value of total iron is reset to this
+                  !! sum (i.e. TFe = FeL + Fe'; but Fe' <= 0.3 umol/m3); this isn't
+                  !! our favoured approach to tracer updating here (not least because
+                  !! of the leapfrog), so here the amount scavenged is augmented by an
+                  !! additional amount that serves to drag total iron back towards that
+                  !! expected from this limitation on iron concentration ...
+                  !!
+                  xmaxFeF     = min((xFeF * 1.e3), 0.3)             ! = umol/m3
+                  !!
+                  !! Here, the difference between current total Fe and (FeL + Fe') is
+                  !! calculated and added to the scavenging flux already calculated
+                  !! above ...
+                  !!
+                  fdeltaFe    = (xFeT - (xFeL + xmaxFeF)) * 1.e-3   ! = mmol/m3
+                  !!
+                  !! This assumes that the "excess" iron is dissipated with a time-
+                  !! scale of 1 day; seems reasonable to me ... (famous last words)
+                  !!
+                  ffescav     = ffescav + fdeltaFe                  ! = mmol/m3/d
+                  !!
+# if defined key_deep_fe_fix
+                  !! AXY (17/01/13)
+                  !! stop scavenging for iron concentrations below 0.5 umol / m3
+                  !! at depths greater than 1000 m; this aims to end MEDUSA's
+                  !! continual loss of iron at depth without impacting things
+                  !! at the surface too much; the justification for this is that
+                  !! it appears to be what Mick Follows et al. do in their work
+                  !! (as evidenced by the iron initial condition they supplied
+                  !! me with); to be honest, it looks like Follow et al. do this
+                  !! at shallower depths than 1000 m, but I'll stick with this
+                  !! for now; I suspect that this seemingly arbitrary approach
+                  !! effectively "parameterises" the particle-based scavenging
+                  !! rates that other models use (i.e. at depth there are no
+                  !! sinking particles, so scavenging stops); it might be fun
+                  !! justifying this in a paper though!
+                  !!
+                  if ((fdep.gt.1000.) .and. (xFeT.lt.0.5)) then
+                     ffescav = 0.
+                  endif
+# endif
+                  !!
+               elseif (jiron.eq.2) then
+                  !!----------------------------------------------------------------------
+                  !! Scheme 2: Moore et al. (2004)
+                  !! This scheme includes a single scavenging term that accounts for
+                  !! both suspended and sinking particles in the water column; this
+                  !! term scavenges total iron rather than "free" iron
+                  !!----------------------------------------------------------------------
+                  !!
+                  !! total iron concentration (mmol Fe / m3 -> umol Fe / m3)
+                  xFeT        = zfer * 1.e3
+                  !!
+                  !! this has a base scavenging rate (12% / y) which is modified by local
+                  !! particle concentration and sinking flux (and dust - but I'm ignoring
+                  !! that here for now) and which is accelerated when Fe concentration gets
+                  !! 0.6 nM (= 0.6 umol/m3 = 0.0006 mmol/m3), and decreased as concentrations
+                  !! below 0.4 nM (= 0.4 umol/m3 = 0.0004 mmol/m3)
+                  !!
+                  !! base scavenging rate (0.12 / y)
+                  fbase_scav = 0.12 / 365.25
+                  !!
+                  !! calculate sinking particle part of scaling factor
+                  !! this takes local fast sinking carbon (mmol C / m2 / d) and
+                  !! gets it into nmol C / cm3 / s ("rdt" below is the number of seconds in
+                  !! a model timestep)
+                  !!
+                  !! fscal_sink = ffastc(ji,jj) * 1.e2 / (86400.)
+                  !!
+                  !! ... actually, re-reading Moore et al.'s equations, it looks like he uses
+                  !! his sinking flux directly, without scaling it by time-step or anything,
+                  !! so I'll copy this here ...
+                  !!
+                  fscal_sink = ffastc(ji,jj) * 1.e2
+                  !!
+                  !! calculate particle part of scaling factor
+                  !! this totals up the carbon in suspended particles (Pn, Pd, Zmi, Zme, D),
+                  !! which comes out in mmol C / m3 (= nmol C / cm3), and then multiplies it
+                  !! by a magic factor, 0.002, to get it into nmol C / cm2 / s
+                  !!
+                  fscal_part = ((xthetapn * zphn) + (xthetapd * zphd) + (xthetazmi * zzmi) + &
+                  (xthetazme * zzme) + (xthetad * zdet)) * 0.002
+                  !!
+                  !! calculate scaling factor for base scavenging rate
+                  !! this uses the (now correctly scaled) sinking flux and standing
+                  !! particle concentration, divides through by some sort of reference
+                  !! value (= 0.0066 nmol C / cm2 / s) and then uses this, or not if its
+                  !! too high, to rescale the base scavenging rate
+                  !!
+                  fscal_scav = fbase_scav * min(((fscal_sink + fscal_part) / 0.0066), 4.0)
+                  !!
+                  !! the resulting scavenging rate is then scaled further according to the
+                  !! local iron concentration (i.e. diminished in low iron regions; enhanced
+                  !! in high iron regions; less alone in intermediate iron regions)
+                  !!
+                  if (xFeT.lt.0.4) then
+                     !!
+                     !! low iron region
+                     !!
+                     fscal_scav = fscal_scav * (xFeT / 0.4)
+                     !!
+                  elseif (xFeT.gt.0.6) then
+                     !!
+                     !! high iron region
+                     !!
+                     fscal_scav = fscal_scav + ((xFeT / 0.6) * (6.0 / 1.4))
+                     !!
+                  else
+                     !!
+                     !! intermediate iron region: do nothing
+                     !!
+                  endif
+                  !! 
+                  !! apply the calculated scavenging rate ...
+                  !!
+                  ffescav = fscal_scav * zfer
+                  !!
+               elseif (jiron.eq.3) then
+                  !!----------------------------------------------------------------------
+                  !! Scheme 3: Moore et al. (2008)
+                  !! This scheme includes a single scavenging term that accounts for
+                  !! sinking particles in the water column, and includes organic C,
+                  !! biogenic opal, calcium carbonate and dust in this (though the
+                  !! latter is ignored here until I work out what units the incoming
+                  !! "dust" flux is in); this term scavenges total iron rather than 
+                  !! "free" iron
+                  !!----------------------------------------------------------------------
+                  !!
+                  !! total iron concentration (mmol Fe / m3 -> umol Fe / m3)
+                  xFeT        = zfer * 1.e3
+                  !!
+                  !! this has a base scavenging rate which is modified by local
+                  !! particle sinking flux (including dust - but I'm ignoring that 
+                  !! here for now) and which is accelerated when Fe concentration
+                  !! is > 0.6 nM (= 0.6 umol/m3 = 0.0006 mmol/m3), and decreased as 
+                  !! concentrations < 0.5 nM (= 0.5 umol/m3 = 0.0005 mmol/m3)
+                  !!
+                  !! base scavenging rate (Fe_b in paper; units may be wrong there)
+                  fbase_scav = 0.00384 ! (ng)^-1 cm
+                  !!
+                  !! calculate sinking particle part of scaling factor; this converts
+                  !! mmol / m2 / d fluxes of organic carbon, silicon and calcium
+                  !! carbonate into ng / cm2 / s fluxes; it is assumed here that the
+                  !! mass conversions simply consider the mass of the main element
+                  !! (C, Si and Ca) and *not* the mass of the molecules that they are
+                  !! part of; Moore et al. (2008) is unclear on the conversion that
+                  !! should be used
+                  !!
+                  !! milli -> nano; mol -> gram; /m2 -> /cm2; /d -> /s
+                  fscal_csink  = (ffastc(ji,jj)  * 1.e6 * xmassc  * 1.e-4 / 86400.)      ! ng C  / cm2 / s
+                  fscal_sisink = (ffastsi(ji,jj) * 1.e6 * xmasssi * 1.e-4 / 86400.)      ! ng Si / cm2 / s
+                  fscal_casink = (ffastca(ji,jj) * 1.e6 * xmassca * 1.e-4 / 86400.)      ! ng Ca / cm2 / s
+                  !! 
+                  !! sum up these sinking fluxes and convert to ng / cm by dividing
+                  !! through by a sinking rate of 100 m / d = 1.157 cm / s
+                  fscal_sink   = ((fscal_csink * 6.) + fscal_sisink + fscal_casink) / &
+                  (100. * 1.e3 / 86400)                                                  ! ng / cm
+                  !!
+                  !! now calculate the scavenging rate based upon the base rate and
+                  !! this particle flux scaling; according to the published units,
+                  !! the result actually has *no* units, but as it must be expressed
+                  !! per unit time for it to make any sense, I'm assuming a missing
+                  !! "per second"
+                  fscal_scav = fbase_scav * fscal_sink                                   ! / s
+                  !!
+                  !! the resulting scavenging rate is then scaled further according to the
+                  !! local iron concentration (i.e. diminished in low iron regions; enhanced
+                  !! in high iron regions; less alone in intermediate iron regions)
+                  !!
+                  if (xFeT.lt.0.5) then
+                     !!
+                     !! low iron region (0.5 instead of the 0.4 in Moore et al., 2004)
+                     !!
+                     fscal_scav = fscal_scav * (xFeT / 0.5)
+                     !!
+                  elseif (xFeT.gt.0.6) then
+                     !!
+                     !! high iron region (functional form different in Moore et al., 2004)
+                     !!
+                     fscal_scav = fscal_scav + ((xFeT - 0.6) * 0.00904)
+                     !!
+                  else
+                     !!
+                     !! intermediate iron region: do nothing
+                     !!
+                  endif
+                  !! 
+                  !! apply the calculated scavenging rate ...
+                  !!
+                  ffescav = fscal_scav * zfer
+                  !!
+               elseif (jiron.eq.4) then
+                  !!----------------------------------------------------------------------
+                  !! Scheme 4: Galbraith et al. (2010)
+                  !! This scheme includes two scavenging terms, one for organic,
+                  !! particle-based scavenging, and another for inorganic scavenging;
+                  !! both terms scavenge "free" iron only
+                  !!----------------------------------------------------------------------
+                  !!
+                  !! Galbraith et al. (2010) present a more straightforward outline of 
+                  !! the scheme in Parekh et al. (2005) ...
+                  !! 
+                  !! sinking particulate carbon available for scavenging
+                  !! this assumes a sinking rate of 100 m / d (Moore & Braucher, 2008),
+                  xCscav1     = (ffastc(ji,jj) * xmassc) / 100. ! = mg C / m3
+                  !! 
+                  !! scale by Honeyman et al. (1981) exponent coefficient
+                  !! multiply by 1.e-3 to express C flux in g C rather than mg C
+                  xCscav2     = (xCscav1 * 1.e-3)**0.58
+                  !!
+                  !! multiply by Galbraith et al. (2010) scavenging rate
+                  xk_org      = 0.5 ! ((g C m/3)^-1) / d
+                  xORGscav    = xk_org * xCscav2 * xFeF
+                  !!
+                  !! Galbraith et al. (2010) also include an inorganic bit ...
+                  !! 
+                  !! this occurs at a fixed rate, again based on the availability of
+                  !! "free" iron
+                  !!
+                  !! k_inorg  = 1000 d**-1 nmol Fe**-0.5 kg**-0.5
+                  !!
+                  !! to implement this here, scale xFeF by 1026 to put in units of
+                  !! umol/m3 which approximately equal nmol/kg
+                  !!
+                  xk_inorg    = 1000. ! ((nmol Fe / kg)^1.5)
+                  xINORGscav  = (xk_inorg * (xFeF * 1026.)**1.5) * 1.e-3
+                  !!
+                  !! sum these two terms together
+                  ffescav     = xORGscav + xINORGscav
+               else
+                  !!----------------------------------------------------------------------
+                  !! No Scheme: you coward!
+                  !! This scheme puts its head in the sand and eskews any decision about
+                  !! how iron is removed from the ocean; prepare to get deluged in iron
+                  !! you fool!
+                  !!----------------------------------------------------------------------
+                  ffescav     = 0.
+               endif
+
+               !!----------------------------------------------------------------------
+               !! Other iron cycle processes
+               !!----------------------------------------------------------------------
+               !!
+               !! aeolian iron deposition
+               if (jk.eq.1) then
+                  !! zirondep   is in mmol-Fe / m2 / day
+                  !! ffetop     is in mmol-dissolved-Fe / m3 / day
+                  ffetop  = zirondep(ji,jj) * xfe_sol / fthk 
+               else
+                  ffetop  = 0.0
+               endif
+               !!
+               !! seafloor iron addition
+               !! AXY (10/07/12): amended to only apply sedimentary flux up to ~500 m down
+               !! if (jk.eq.(mbathy(ji,jj)-1).AND.jk.lt.i1100) then
+               if ((jk.eq.jmbathy).AND.jk.le.i0500) then
+                  !! Moore et al. (2004) cite a coastal California value of 5 umol/m2/d, but adopt a
+                  !! global value of 2 umol/m2/d for all areas < 1100 m; here we use this latter value
+                  !! but apply it everywhere
+                  !! AXY (21/07/09): actually, let's just apply it below 1100 m (levels 1-37)
+                  ffebot  = (xfe_sed / fthk)
+               else
+                  ffebot  = 0.0
+               endif
+
+               !! AXY (16/12/09): remove iron addition/removal processes
+               !! For the purposes of the quarter degree run, the iron cycle is being pegged to the
+               !! initial condition supplied by Mick Follows via restoration with a 30 day period;
+               !! iron addition at the seafloor is still permitted with the idea that this extra
+               !! iron will be removed by the restoration away from the source
+               !! ffescav = 0.0
+               !! ffetop  = 0.0
+               !! ffebot  = 0.0
+
+# if defined key_debug_medusa
+               !! report miscellaneous calculations
+               if (idf.eq.1.AND.idfval.eq.1) then
+                  IF (lwp) write (numout,*) '------------------------------'
+                  IF (lwp) write (numout,*) 'xfe_sol  = ', xfe_sol
+                  IF (lwp) write (numout,*) 'xfe_mass = ', xfe_mass
+                  IF (lwp) write (numout,*) 'ffetop(',jk,')  = ', ffetop
+                  IF (lwp) write (numout,*) 'ffebot(',jk,')  = ', ffebot
+                  IF (lwp) write (numout,*) 'xFree(',jk,')   = ', xFree(ji,jj)
+                  IF (lwp) write (numout,*) 'ffescav(',jk,') = ', ffescav
+               endif
+# endif
+
+               !!----------------------------------------------------------------------
+               !! Miscellaneous
+               !!----------------------------------------------------------------------
+               !!
+               !! diatom frustule dissolution
+               fsdiss  = xsdiss * zpds
+
+# if defined key_debug_medusa
+               !! report miscellaneous calculations
+               if (idf.eq.1.AND.idfval.eq.1) then
+                  IF (lwp) write (numout,*) '------------------------------'
+                  IF (lwp) write (numout,*) 'fsdiss(',jk,')  = ', fsdiss
+               endif
+# endif
+
+               !!----------------------------------------------------------------------
+               !! Slow detritus creation
+               !!----------------------------------------------------------------------
+               !! this variable integrates the creation of slow sinking detritus
+               !! to allow the split between fast and slow detritus to be 
+               !! diagnosed
+               fslown  = fdpn + fdzmi + ((1.0 - xfdfrac1) * fdpd) + &
+               ((1.0 - xfdfrac2) * fdzme) + ((1.0 - xbetan) * (finmi + finme))
+               !!
+               !! this variable records the slow detrital sinking flux at this
+               !! particular depth; it is used in the output of this flux at
+               !! standard depths in the diagnostic outputs; needs to be
+               !! adjusted from per second to per day because of parameter vsed
+               fslownflux(ji,jj) = zdet * vsed * 86400.
+# if defined key_roam
+               !!
+               !! and the same for detrital carbon
+               fslowc  = (xthetapn * fdpn) + (xthetazmi * fdzmi) + &
+               (xthetapd * (1.0 - xfdfrac1) * fdpd) + &
+               (xthetazme * (1.0 - xfdfrac2) * fdzme) + &
+               ((1.0 - xbetac) * (ficmi + ficme))
+               !!
+               !! this variable records the slow detrital sinking flux at this
+               !! particular depth; it is used in the output of this flux at
+               !! standard depths in the diagnostic outputs; needs to be
+               !! adjusted from per second to per day because of parameter vsed
+               fslowcflux(ji,jj) = zdtc * vsed * 86400.
+# endif
+
+               !!----------------------------------------------------------------------
+               !! Nutrient regeneration
+               !! this variable integrates total nitrogen regeneration down the
+               !! watercolumn; its value is stored and output as a 2D diagnostic;
+               !! the corresponding dissolution flux of silicon (from sources
+               !! other than fast detritus) is also integrated; note that,
+               !! confusingly, the linear loss terms from plankton compartments
+               !! are labelled as fdX2 when one might have expected fdX or fdX1
+               !!----------------------------------------------------------------------
+               !!
+               !! nitrogen
+               fregen   = (( (xphi * (fgmipn + fgmid)) +                &  ! messy feeding
+               (xphi * (fgmepn + fgmepd + fgmezmi + fgmed)) +           &  ! messy feeding
+               fmiexcr + fmeexcr + fdd +                                &  ! excretion + D remin.
+               fdpn2 + fdpd2 + fdzmi2 + fdzme2) * fthk)                    ! linear mortality
+               !!
+               !! silicon
+               fregensi = (( fsdiss + ((1.0 - xfdfrac1) * fdpds) +      &  ! dissolution + non-lin. mortality
+               ((1.0 - xfdfrac3) * fgmepds) +                           &  ! egestion by zooplankton
+               fdpds2) * fthk)                                             ! linear mortality
+# if defined key_roam
+               !!
+               !! carbon
+               fregenc  = (( (xphi * ((xthetapn * fgmipn) + fgmidc)) +  &  ! messy feeding
+               (xphi * ((xthetapn * fgmepn) + (xthetapd * fgmepd) +     &  ! messy feeding
+               (xthetazmi * fgmezmi) + fgmedc)) +                       &  ! messy feeding
+               fmiresp + fmeresp + fddc +                               &  ! respiration + D remin.
+               (xthetapn * fdpn2) + (xthetapd * fdpd2) +                &  ! linear mortality
+               (xthetazmi * fdzmi2) + (xthetazme * fdzme2)) * fthk)        ! linear mortality
+# endif
+
+               !!----------------------------------------------------------------------
+               !! Fast-sinking detritus terms
+               !! "local" variables declared so that conservation can be checked;
+               !! the calculated terms are added to the fast-sinking flux later on
+               !! only after the flux entering this level has experienced some
+               !! remineralisation
+               !! note: these fluxes need to be scaled by the level thickness
+               !!----------------------------------------------------------------------
+               !!
+               !! nitrogen:   diatom and mesozooplankton mortality
+               ftempn         = b0 * ((xfdfrac1 * fdpd)  + (xfdfrac2 * fdzme))
+               !!
+               !! silicon:    diatom mortality and grazed diatoms
+               ftempsi        = b0 * ((xfdfrac1 * fdpds) + (xfdfrac3 * fgmepds))
+               !!
+               !! iron:       diatom and mesozooplankton mortality
+               ftempfe        = b0 * (((xfdfrac1 * fdpd) + (xfdfrac2 * fdzme)) * xrfn)
+               !!
+               !! carbon:     diatom and mesozooplankton mortality
+               ftempc         = b0 * ((xfdfrac1 * xthetapd * fdpd) + & 
+                                (xfdfrac2 * xthetazme * fdzme))
+               !!
+# if defined key_roam
+               if (jrratio.eq.0) then
+                  !! CaCO3:      latitudinally-based fraction of total primary production
+                  !!               absolute latitude of current grid cell
+                  flat           = abs(gphit(ji,jj))
+                  !!               0.10 at equator; 0.02 at pole
+                  fcaco3         = xcaco3a + ((xcaco3b - xcaco3a) * ((90.0 - flat) / 90.0))
+               elseif (jrratio.eq.1) then
+                  !! CaCO3:      Ridgwell et al. (2007) submodel, version 1
+                  !!             this uses SURFACE omega calcite to regulate rain ratio
+                  if (f_omcal(ji,jj).ge.1.0) then
+                     fq1 = (f_omcal(ji,jj) - 1.0)**0.81
+                  else
+                     fq1 = 0.
+                  endif
+                  fcaco3 = xridg_r0 * fq1
+               elseif (jrratio.eq.2) then
+                  !! CaCO3:      Ridgwell et al. (2007) submodel, version 2
+                  !!             this uses FULL 3D omega calcite to regulate rain ratio
+                  if (f3_omcal(ji,jj,jk).ge.1.0) then
+                     fq1 = (f3_omcal(ji,jj,jk) - 1.0)**0.81
+                  else
+                     fq1 = 0.
+                  endif
+                  fcaco3 = xridg_r0 * fq1
+               endif
+# else
+               !! CaCO3:      latitudinally-based fraction of total primary production
+               !!               absolute latitude of current grid cell
+               flat           = abs(gphit(ji,jj))
+               !!               0.10 at equator; 0.02 at pole
+               fcaco3         = xcaco3a + ((xcaco3b - xcaco3a) * ((90.0 - flat) / 90.0))
+# endif
+               !! AXY (09/03/09): convert CaCO3 production from function of 
+               !! primary production into a function of fast-sinking material; 
+               !! technically, this is what Dunne et al. (2007) do anyway; they 
+               !! convert total primary production estimated from surface 
+               !! chlorophyll to an export flux for which they apply conversion 
+               !! factors to estimate the various elemental fractions (Si, Ca)
+               ftempca        = ftempc * fcaco3
+
+# if defined key_debug_medusa
+               !! integrate total fast detritus production
+               if (idf.eq.1) then
+                  fifd_n(ji,jj)  = fifd_n(ji,jj)  + (ftempn  * fthk)
+                  fifd_si(ji,jj) = fifd_si(ji,jj) + (ftempsi * fthk)
+                  fifd_fe(ji,jj) = fifd_fe(ji,jj) + (ftempfe * fthk)
+#  if defined key_roam
+                  fifd_c(ji,jj)  = fifd_c(ji,jj)  + (ftempc  * fthk)
+#  endif
+               endif
+
+               !! report quantities of fast-sinking detritus for each component
+               if (idf.eq.1.AND.idfval.eq.1) then
+                  IF (lwp) write (numout,*) '------------------------------'
+                  IF (lwp) write (numout,*) 'fdpd(',jk,')    = ', fdpd
+                  IF (lwp) write (numout,*) 'fdzme(',jk,')   = ', fdzme
+                  IF (lwp) write (numout,*) 'ftempn(',jk,')  = ', ftempn
+                  IF (lwp) write (numout,*) 'ftempsi(',jk,') = ', ftempsi
+                  IF (lwp) write (numout,*) 'ftempfe(',jk,') = ', ftempfe
+                  IF (lwp) write (numout,*) 'ftempc(',jk,')  = ', ftempc
+                  IF (lwp) write (numout,*) 'ftempca(',jk,') = ', ftempca
+                  IF (lwp) write (numout,*) 'flat(',jk,')    = ', flat
+                  IF (lwp) write (numout,*) 'fcaco3(',jk,')  = ', fcaco3
+               endif
+# endif
+
+               !!----------------------------------------------------------------------
+               !! This version of MEDUSA offers a choice of three methods for
+               !! handling the remineralisation of fast detritus.  All three
+               !! do so in broadly the same way:
+               !!
+               !!   1.  Fast detritus is stored as a 2D array                   [ ffastX  ]
+               !!   2.  Fast detritus is added level-by-level                   [ ftempX  ]
+               !!   3.  Fast detritus is not remineralised in the top box       [ freminX ]
+               !!   4.  Remaining fast detritus is remineralised in the bottom  [ fsedX   ]
+               !!       box
+               !!
+               !! The three remineralisation methods are:
+               !!   
+               !!   1.  Ballast model (i.e. that published in Yool et al., 2011)
+               !!  (1b. Ballast-sans-ballast model)
+               !!   2.  Martin et al. (1987)
+               !!   3.  Henson et al. (2011)
+               !! 
+               !! The first of these couples C, N and Fe remineralisation to
+               !! the remineralisation of particulate Si and CaCO3, but the 
+               !! latter two treat remineralisation of C, N, Fe, Si and CaCO3
+               !! completely separately.  At present a switch within the code
+               !! regulates which submodel is used, but this should be moved
+               !! to the namelist file.
+               !! 
+               !! The ballast-sans-ballast submodel is an original development
+               !! feature of MEDUSA in which the ballast submodel's general
+               !! framework and parameterisation is used, but in which there
+               !! is no protection of organic material afforded by ballasting
+               !! minerals.  While similar, it is not the same as the Martin 
+               !! et al. (1987) submodel.
+               !!
+               !! Since the three submodels behave the same in terms of
+               !! accumulating sinking material and remineralising it all at
+               !! the seafloor, these portions of the code below are common to
+               !! all three.
+               !!----------------------------------------------------------------------
+
+               if (jexport.eq.1) then
+                  !!======================================================================
+                  !! BALLAST SUBMODEL
+                  !!======================================================================
+                  !! 
+                  !!----------------------------------------------------------------------
+                  !! Fast-sinking detritus fluxes, pt. 1: REMINERALISATION
+                  !! aside from explicitly modelled, slow-sinking detritus, the
+                  !! model includes an implicit representation of detrital
+                  !! particles that sink too quickly to be modelled with
+                  !! explicit state variables; this sinking flux is instead
+                  !! instantaneously remineralised down the water column using
+                  !! the version of Armstrong et al. (2002)'s ballast model
+                  !! used by Dunne et al. (2007); the version of this model
+                  !! here considers silicon and calcium carbonate ballast
+                  !! minerals; this section of the code redistributes the fast
+                  !! sinking material generated locally down the water column;
+                  !! this differs from Dunne et al. (2007) in that fast sinking
+                  !! material is distributed at *every* level below that it is
+                  !! generated, rather than at every level below some fixed
+                  !! depth; this scheme is also different in that sinking material 
+                  !! generated in one level is aggregated with that generated by
+                  !! shallower levels; this should make the ballast model more
+                  !! self-consistent (famous last words)
+                  !!----------------------------------------------------------------------
+                  !!
+                  if (jk.eq.1) then
+                     !! this is the SURFACE OCEAN BOX (no remineralisation)
+                     !!
+                     freminc  = 0.0
+                     freminn  = 0.0
+                     freminfe = 0.0
+                     freminsi = 0.0
+                     freminca = 0.0
+                  elseif (jk.le.jmbathy) then
+                     !! this is an OCEAN BOX (remineralise some material)
+                     !!
+                     !! set up CCD depth to be used depending on user choice
+                     if (jocalccd.eq.0) then
+                        !! use default CCD field
+                        fccd_dep = ocal_ccd(ji,jj)
+                     elseif (jocalccd.eq.1) then
+                        !! use calculated CCD field
+                        fccd_dep = f2_ccd_cal(ji,jj)
+                     endif
+                     !!
+                     !! === organic carbon ===
+                     fq0      = ffastc(ji,jj)                        !! how much organic C enters this box        (mol)
+                     if (iball.eq.1) then
+                        fq1      = (fq0 * xmassc)                    !! how much it weighs                        (mass)
+                        fq2      = (ffastca(ji,jj) * xmassca)        !! how much CaCO3 enters this box            (mass)
+                        fq3      = (ffastsi(ji,jj) * xmasssi)        !! how much  opal enters this box            (mass)
+                        fq4      = (fq2 * xprotca) + (fq3 * xprotsi) !! total protected organic C                 (mass)
+                        !! this next term is calculated for C but used for N and Fe as well
+                        !! it needs to be protected in case ALL C is protected
+                        if (fq4.lt.fq1) then
+                           fprotf   = (fq4 / (fq1 + tiny(fq1)))      !! protected fraction of total organic C     (non-dim)
+                        else
+                           fprotf   = 1.0                            !! all organic C is protected                (non-dim)
+                        endif
+                        fq5      = (1.0 - fprotf)                    !! unprotected fraction of total organic C   (non-dim)
+                        fq6      = (fq0 * fq5)                       !! how much organic C is unprotected         (mol)
+                        fq7      = (fq6 * exp(-(fthk / xfastc)))     !! how much unprotected C leaves this box    (mol)
+                        fq8      = (fq7 + (fq0 * fprotf))            !! how much total C leaves this box          (mol)
+                        freminc  = (fq0 - fq8) / fthk                !! C remineralisation in this box            (mol)
+                        ffastc(ji,jj) = fq8                          
+# if defined key_debug_medusa
+                        !! report in/out/remin fluxes of carbon for this level
+                           if (idf.eq.1.AND.idfval.eq.1) then
+                              IF (lwp) write (numout,*) '------------------------------'
+                              IF (lwp) write (numout,*) 'totalC(',jk,')  = ', fq1
+                              IF (lwp) write (numout,*) 'prtctC(',jk,')  = ', fq4
+                              IF (lwp) write (numout,*) 'fprotf(',jk,')  = ', fprotf
+                              IF (lwp) write (numout,*) '------------------------------'
+                              IF (lwp) write (numout,*) 'IN   C(',jk,')  = ', fq0
+                              IF (lwp) write (numout,*) 'LOST C(',jk,')  = ', freminc * fthk
+                              IF (lwp) write (numout,*) 'OUT  C(',jk,')  = ', fq8
+                              IF (lwp) write (numout,*) 'NEW  C(',jk,')  = ', ftempc * fthk
+                           endif
+# endif
+                        else
+                        fq1      = fq0 * exp(-(fthk / xfastc))       !! how much organic C leaves this box        (mol)
+                        freminc  = (fq0 - fq1) / fthk                !! C remineralisation in this box            (mol)
+                        ffastc(ji,jj)  = fq1
+                     endif
+                     !!
+                     !! === organic nitrogen ===
+                     fq0      = ffastn(ji,jj)                        !! how much organic N enters this box        (mol)
+                     if (iball.eq.1) then
+                        fq5      = (1.0 - fprotf)                    !! unprotected fraction of total organic N   (non-dim)
+                        fq6      = (fq0 * fq5)                       !! how much organic N is unprotected         (mol)
+                        fq7      = (fq6 * exp(-(fthk / xfastc)))     !! how much unprotected N leaves this box    (mol)
+                        fq8      = (fq7 + (fq0 * fprotf))            !! how much total N leaves this box          (mol)
+                        freminn  = (fq0 - fq8) / fthk                !! N remineralisation in this box            (mol)
+                        ffastn(ji,jj)  = fq8
+# if defined key_debug_medusa
+                        !! report in/out/remin fluxes of carbon for this level
+                        if (idf.eq.1.AND.idfval.eq.1) then
+                           IF (lwp) write (numout,*) '------------------------------'
+                           IF (lwp) write (numout,*) 'totalN(',jk,')  = ', fq1
+                           IF (lwp) write (numout,*) 'prtctN(',jk,')  = ', fq4
+                           IF (lwp) write (numout,*) 'fprotf(',jk,')  = ', fprotf
+                           IF (lwp) write (numout,*) '------------------------------'
+                           if (freminn < 0.0) then
+                              IF (lwp) write (numout,*) '** FREMIN ERROR **'
+                           endif
+                           IF (lwp) write (numout,*) 'IN   N(',jk,')  = ', fq0
+                           IF (lwp) write (numout,*) 'LOST N(',jk,')  = ', freminn * fthk
+                           IF (lwp) write (numout,*) 'OUT  N(',jk,')  = ', fq8
+                           IF (lwp) write (numout,*) 'NEW  N(',jk,')  = ', ftempn * fthk
+                        endif
+# endif
+                     else
+                        fq1      = fq0 * exp(-(fthk / xfastc))       !! how much organic N leaves this box        (mol)
+                        freminn  = (fq0 - fq1) / fthk                !! N remineralisation in this box            (mol)
+                        ffastn(ji,jj)  = fq1
+                     endif
+                     !!
+                     !! === organic iron ===
+                     fq0      = ffastfe(ji,jj)                       !! how much organic Fe enters this box       (mol)
+                     if (iball.eq.1) then
+                        fq5      = (1.0 - fprotf)                    !! unprotected fraction of total organic Fe  (non-dim)
+                        fq6      = (fq0 * fq5)                       !! how much organic Fe is unprotected        (mol)
+                        fq7      = (fq6 * exp(-(fthk / xfastc)))     !! how much unprotected Fe leaves this box   (mol)
+                        fq8      = (fq7 + (fq0 * fprotf))            !! how much total Fe leaves this box         (mol)            
+                        freminfe = (fq0 - fq8) / fthk                !! Fe remineralisation in this box           (mol)
+                        ffastfe(ji,jj) = fq8
+                     else
+                        fq1      = fq0 * exp(-(fthk / xfastc))       !! how much total Fe leaves this box         (mol)      
+                        freminfe = (fq0 - fq1) / fthk                !! Fe remineralisation in this box           (mol)
+                        ffastfe(ji,jj) = fq1
+                     endif
+                     !!
+                     !! === biogenic silicon ===
+                     fq0      = ffastsi(ji,jj)                       !! how much  opal centers this box           (mol) 
+                     fq1      = fq0 * exp(-(fthk / xfastsi))         !! how much  opal leaves this box            (mol)
+                     freminsi = (fq0 - fq1) / fthk                   !! Si remineralisation in this box           (mol)
+                     ffastsi(ji,jj) = fq1
+                     !!
+                     !! === biogenic calcium carbonate ===
+                     fq0      = ffastca(ji,jj)                       !! how much CaCO3 enters this box            (mol)
+                     if (fdep.le.fccd_dep) then
+                        !! whole grid cell above CCD
+                        fq1      = fq0                               !! above lysocline, no Ca dissolves          (mol)
+                        freminca = 0.0                               !! above lysocline, no Ca dissolves          (mol)
+                        fccd(ji,jj) = real(jk)                       !! which is the last level above the CCD?    (#)
+                     elseif (fdep.ge.fccd_dep) then
+                        !! whole grid cell below CCD
+                        fq1      = fq0 * exp(-(fthk / xfastca))      !! how much CaCO3 leaves this box            (mol)
+                        freminca = (fq0 - fq1) / fthk                !! Ca remineralisation in this box           (mol)
+                     else
+                        !! partial grid cell below CCD
+                        fq2      = fdep1 - fccd_dep                  !! amount of grid cell below CCD             (m)
+                        fq1      = fq0 * exp(-(fq2 / xfastca))       !! how much CaCO3 leaves this box            (mol)
+                        freminca = (fq0 - fq1) / fthk                !! Ca remineralisation in this box           (mol)
+                     endif
+                     ffastca(ji,jj) = fq1 
+                  else
+                     !! this is BELOW THE LAST OCEAN BOX (do nothing)
+                     freminc  = 0.0
+                     freminn  = 0.0
+                     freminfe = 0.0
+                     freminsi = 0.0
+                     freminca = 0.0              
+                  endif
+
+               elseif (jexport.eq.2.or.jexport.eq.3) then
+                  if (jexport.eq.2) then
+                     !!======================================================================
+                     !! MARTIN ET AL. (1987) SUBMODEL
+                     !!======================================================================
+                     !! 
+                     !!----------------------------------------------------------------------
+                     !! This submodel uses the classic Martin et al. (1987) curve
+                     !! to determine the attenuation of fast-sinking detritus down
+                     !! the water column.  All three organic elements, C, N and Fe,
+                     !! are handled identically, and their quantities in sinking
+                     !! particles attenuate according to a power relationship
+                     !! governed by parameter "b".  This is assigned a canonical 
+                     !! value of -0.858.  Biogenic opal and calcium carbonate are
+                     !! attentuated using the same function as in the ballast
+                     !! submodel
+                     !!----------------------------------------------------------------------
+                     !!
+                     fb_val = -0.858
+                  elseif (jexport.eq.3) then
+                     !!======================================================================
+                     !! HENSON ET AL. (2011) SUBMODEL
+                     !!======================================================================
+                     !!
+                     !!----------------------------------------------------------------------
+                     !! This submodel reconfigures the Martin et al. (1987) curve by
+                     !! allowing the "b" value to vary geographically.  Its value is
+                     !! set, following Henson et al. (2011), as a function of local
+                     !! sea surface temperature:
+                     !!   b = -1.06 + (0.024 * SST)
+                     !! This means that remineralisation length scales are longer in
+                     !! warm, tropical areas and shorter in cold, polar areas.  This
+                     !! does seem back-to-front (i.e. one would expect GREATER
+                     !! remineralisation in warmer waters), but is an outcome of 
+                     !! analysis of sediment trap data, and it may reflect details
+                     !! of ecosystem structure that pertain to particle production
+                     !! rather than simply Q10.
+                     !!----------------------------------------------------------------------
+                     !!
+                     fl_sst = tsn(ji,jj,1,jp_tem)
+                     fb_val = -1.06 + (0.024 * fl_sst)
+                  endif
+                  !!   
+                  if (jk.eq.1) then
+                     !! this is the SURFACE OCEAN BOX (no remineralisation)
+                     !!
+                     freminc  = 0.0
+                     freminn  = 0.0
+                     freminfe = 0.0
+                     freminsi = 0.0
+                     freminca = 0.0
+                  elseif (jk.le.jmbathy) then
+                     !! this is an OCEAN BOX (remineralise some material)
+                     !!
+                     !! === organic carbon ===
+                     fq0      = ffastc(ji,jj)                        !! how much organic C enters this box        (mol)
+                     fq1      = fq0 * ((fdep1/fdep)**fb_val)         !! how much organic C leaves this box        (mol)
+                     freminc  = (fq0 - fq1) / fthk                   !! C remineralisation in this box            (mol)
+                     ffastc(ji,jj)  = fq1
+                     !!
+                     !! === organic nitrogen ===
+                     fq0      = ffastn(ji,jj)                        !! how much organic N enters this box        (mol)
+                     fq1      = fq0 * ((fdep1/fdep)**fb_val)         !! how much organic N leaves this box        (mol)
+                     freminn  = (fq0 - fq1) / fthk                   !! N remineralisation in this box            (mol)
+                     ffastn(ji,jj)  = fq1
+                     !!
+                     !! === organic iron ===
+                     fq0      = ffastfe(ji,jj)                       !! how much organic Fe enters this box       (mol)
+                     fq1      = fq0 * ((fdep1/fdep)**fb_val)         !! how much organic Fe leaves this box       (mol)
+                     freminfe = (fq0 - fq1) / fthk                   !! Fe remineralisation in this box           (mol)
+                     ffastfe(ji,jj) = fq1
+                     !!
+                     !! === biogenic silicon ===
+                     fq0      = ffastsi(ji,jj)                       !! how much  opal centers this box           (mol) 
+                     fq1      = fq0 * exp(-(fthk / xfastsi))         !! how much  opal leaves this box            (mol)
+                     freminsi = (fq0 - fq1) / fthk                   !! Si remineralisation in this box           (mol)
+                     ffastsi(ji,jj) = fq1
+                     !!
+                     !! === biogenic calcium carbonate ===
+                     fq0      = ffastca(ji,jj)                       !! how much CaCO3 enters this box            (mol)
+                     if (fdep.le.ocal_ccd(ji,jj)) then
+                        !! whole grid cell above CCD
+                        fq1      = fq0                               !! above lysocline, no Ca dissolves          (mol)
+                        freminca = 0.0                               !! above lysocline, no Ca dissolves          (mol)
+                        fccd(ji,jj) = real(jk)                       !! which is the last level above the CCD?    (#)
+                     elseif (fdep.ge.ocal_ccd(ji,jj)) then
+                        !! whole grid cell below CCD
+                        fq1      = fq0 * exp(-(fthk / xfastca))      !! how much CaCO3 leaves this box            (mol)
+                        freminca = (fq0 - fq1) / fthk                !! Ca remineralisation in this box           (mol)
+                     else
+                        !! partial grid cell below CCD
+                        fq2      = fdep1 - ocal_ccd(ji,jj)           !! amount of grid cell below CCD             (m)
+                        fq1      = fq0 * exp(-(fq2 / xfastca))       !! how much CaCO3 leaves this box            (mol)
+                        freminca = (fq0 - fq1) / fthk                !! Ca remineralisation in this box           (mol)
+                     endif
+                     ffastca(ji,jj) = fq1 
+                  else
+                     !! this is BELOW THE LAST OCEAN BOX (do nothing)
+                     freminc  = 0.0
+                     freminn  = 0.0
+                     freminfe = 0.0
+                     freminsi = 0.0
+                     freminca = 0.0              
+                  endif
+
+               endif
+
+               !!----------------------------------------------------------------------
+               !! Fast-sinking detritus fluxes, pt. 2: UPDATE FAST FLUXES
+               !! here locally calculated additions to the fast-sinking flux are added
+               !! to the total fast-sinking flux; this is done here such that material
+               !! produced in a particular layer is only remineralised below this
+               !! layer
+               !!----------------------------------------------------------------------
+               !!
+               !! add sinking material generated in this layer to running totals
+               !!
+               !! === organic carbon ===                          (diatom and mesozooplankton mortality)
+               ffastc(ji,jj)  = ffastc(ji,jj)  + (ftempc  * fthk)
+               !!
+               !! === organic nitrogen ===                        (diatom and mesozooplankton mortality)
+               ffastn(ji,jj)  = ffastn(ji,jj)  + (ftempn  * fthk)
+               !!
+               !! === organic iron ===                            (diatom and mesozooplankton mortality)
+               ffastfe(ji,jj) = ffastfe(ji,jj) + (ftempfe * fthk)
+               !!
+               !! === biogenic silicon ===                        (diatom mortality and grazed diatoms)
+               ffastsi(ji,jj) = ffastsi(ji,jj) + (ftempsi * fthk)
+               !!
+               !! === biogenic calcium carbonate ===              (latitudinally-based fraction of total primary production)
+               ffastca(ji,jj) = ffastca(ji,jj) + (ftempca * fthk)
+
+               !!----------------------------------------------------------------------
+               !! Fast-sinking detritus fluxes, pt. 3: SEAFLOOR
+               !! remineralise all remaining fast-sinking detritus to dissolved
+               !! nutrients; the sedimentation fluxes calculated here allow the
+               !! separation of what's remineralised sinking through the final
+               !! ocean box from that which is added to the final box by the
+               !! remineralisation of material that reaches the seafloor (i.e.
+               !! the model assumes that *all* material that hits the seafloor
+               !! is remineralised and that none is permanently buried; hey,
+               !! this is a giant GCM model that can't be run for long enough
+               !! to deal with burial fluxes!)
+               !!
+               !! in a change to this process, in part so that MEDUSA behaves
+               !! a little more like ERSEM et al., fast-sinking detritus (N, Fe
+               !! and C) is converted to slow sinking detritus at the seafloor
+               !! instead of being remineralised; the rationale is that in
+               !! shallower shelf regions (... that are not fully mixed!) this
+               !! allows the detrital material to return slowly to dissolved 
+               !! nutrient rather than instantaneously as now; the alternative
+               !! would be to explicitly handle seafloor organic material - a
+               !! headache I don't wish to experience at this point; note that
+               !! fast-sinking Si and Ca detritus is just remineralised as 
+               !! per usual
+               !! 
+               !! AXY (13/01/12)
+               !! in a further change to this process, again so that MEDUSA is
+               !! a little more like ERSEM et al., material that reaches the
+               !! seafloor can now be added to sediment pools and stored for
+               !! slow release; there are new 2D arrays for organic nitrogen,
+               !! iron and carbon and inorganic silicon and carbon that allow
+               !! fast and slow detritus that reaches the seafloor to be held
+               !! and released back to the water column more slowly; these arrays
+               !! are transferred via the tracer restart files between repeat
+               !! submissions of the model
+               !!----------------------------------------------------------------------
+               !! 
+               ffast2slowc  = 0.0
+               ffast2slown  = 0.0
+               ffast2slowfe = 0.0
+               !!
+               if (jk.eq.jmbathy) then
+                  !! this is the BOTTOM OCEAN BOX (remineralise everything)
+                  !!
+                  !! AXY (17/01/12): tweaked to include benthos pools
+                  !! 
+                  !! === organic carbon ===
+                  if (jfdfate.eq.0 .and. jorgben.eq.0) then
+                     freminc  = freminc + (ffastc(ji,jj) / fthk)    !! C remineralisation in this box            (mol/m3)
+                  elseif (jfdfate.eq.1 .and. jorgben.eq.0) then
+                     ffast2slowc = ffastc(ji,jj) / fthk             !! fast C -> slow C                          (mol/m3)
+                     fslowc      = fslowc + ffast2slowc
+                  elseif (jfdfate.eq.0 .and. jorgben.eq.1) then
+                     f_fbenin_c(ji,jj)  = ffastc(ji,jj)             !! fast C -> benthic C                       (mol/m2)
+                  endif
+                  fsedc(ji,jj)   = ffastc(ji,jj)                          !! record seafloor C                         (mol/m2)
+                  ffastc(ji,jj)  = 0.0
+                  !!
+                  !! === organic nitrogen ===
+                  if (jfdfate.eq.0 .and. jorgben.eq.0) then
+                     freminn  = freminn + (ffastn(ji,jj) / fthk)    !! N remineralisation in this box            (mol/m3)
+                  elseif (jfdfate.eq.1 .and. jorgben.eq.0) then
+                     ffast2slown = ffastn(ji,jj) / fthk             !! fast N -> slow N                          (mol/m3)
+                     fslown      = fslown + ffast2slown
+                  elseif (jfdfate.eq.0 .and. jorgben.eq.1) then
+                     f_fbenin_n(ji,jj)  = ffastn(ji,jj)             !! fast N -> benthic N                       (mol/m2)
+                  endif
+                  fsedn(ji,jj)   = ffastn(ji,jj)                          !! record seafloor N                         (mol/m2)
+                  ffastn(ji,jj)  = 0.0
+                  !!
+                  !! === organic iron ===
+                  if (jfdfate.eq.0 .and. jorgben.eq.0) then
+                     freminfe = freminfe + (ffastfe(ji,jj) / fthk)  !! Fe remineralisation in this box           (mol/m3)
+                  elseif (jfdfate.eq.1 .and. jorgben.eq.0) then
+                     ffast2slowfe = ffastn(ji,jj) / fthk            !! fast Fe -> slow Fe                        (mol/m3)
+                  elseif (jfdfate.eq.0 .and. jorgben.eq.1) then
+                     f_fbenin_fe(ji,jj) = ffastfe(ji,jj)            !! fast Fe -> benthic Fe                     (mol/m2)
+                  endif
+                  fsedfe(ji,jj)  = ffastfe(ji,jj)                         !! record seafloor Fe                        (mol/m2)
+                  ffastfe(ji,jj) = 0.0
+                  !!
+                  !! === biogenic silicon ===
+                  if (jinorgben.eq.0) then
+                     freminsi = freminsi + (ffastsi(ji,jj) / fthk)  !! Si remineralisation in this box           (mol/m3)
+                  elseif (jinorgben.eq.1) then
+                     f_fbenin_si(ji,jj) = ffastsi(ji,jj)            !! fast Si -> benthic Si                     (mol/m2)
+                  endif
+                  fsedsi(ji,jj)   = ffastsi(ji,jj)                         !! record seafloor Si                        (mol/m2)
+                  ffastsi(ji,jj) = 0.0
+                  !!
+                  !! === biogenic calcium carbonate ===
+                  if (jinorgben.eq.0) then
+                     freminca = freminca + (ffastca(ji,jj) / fthk)  !! Ca remineralisation in this box           (mol/m3) 
+                  elseif (jinorgben.eq.1) then
+                     f_fbenin_ca(ji,jj) = ffastca(ji,jj)            !! fast Ca -> benthic Ca                     (mol/m2)
+                  endif
+                  fsedca(ji,jj)   = ffastca(ji,jj)                         !! record seafloor Ca                        (mol/m2)
+                  ffastca(ji,jj) = 0.0
+               endif
+
+# if defined key_debug_medusa
+               if (idf.eq.1) then
+                  !!----------------------------------------------------------------------
+                  !! Integrate total fast detritus remineralisation
+                  !!----------------------------------------------------------------------
+                  !!
+                  fofd_n(ji,jj)  = fofd_n(ji,jj)  + (freminn  * fthk)
+                  fofd_si(ji,jj) = fofd_si(ji,jj) + (freminsi * fthk)
+                  fofd_fe(ji,jj) = fofd_fe(ji,jj) + (freminfe * fthk)
+#  if defined key_roam
+                  fofd_c(ji,jj)  = fofd_c(ji,jj)  + (freminc  * fthk)
+#  endif
+               endif
+# endif
+
+               !!----------------------------------------------------------------------
+               !! Sort out remineralisation tally of fast-sinking detritus
+               !!----------------------------------------------------------------------
+               !!
+               !! update fast-sinking regeneration arrays
+               fregenfast(ji,jj)   = fregenfast(ji,jj)   + (freminn  * fthk)
+               fregenfastsi(ji,jj) = fregenfastsi(ji,jj) + (freminsi * fthk)
+# if defined key_roam
+               fregenfastc(ji,jj)  = fregenfastc(ji,jj)  + (freminc  * fthk)
+# endif
+
+               !!----------------------------------------------------------------------
+               !! Benthic remineralisation fluxes
+               !!----------------------------------------------------------------------
+               !!
+               if (jk.eq.jmbathy) then
+                  !!
+                  !! organic components
+                  if (jorgben.eq.1) then
+                     f_benout_n(ji,jj)  = xsedn  * zn_sed_n(ji,jj)
+                     f_benout_fe(ji,jj) = xsedfe * zn_sed_fe(ji,jj)
+                     f_benout_c(ji,jj)  = xsedc  * zn_sed_c(ji,jj)
+                  endif
+                  !!
+                  !! inorganic components
+                  if (jinorgben.eq.1) then
+                     f_benout_si(ji,jj) = xsedsi * zn_sed_si(ji,jj)
+                     f_benout_ca(ji,jj) = xsedca * zn_sed_ca(ji,jj)
+                     !!
+                     !! account for CaCO3 that dissolves when it shouldn't
+                     if ( fdep .le. fccd_dep ) then
+                        f_benout_lyso_ca(ji,jj) = xsedca * zn_sed_ca(ji,jj)
+                     endif
+                  endif
+               endif
+               CALL flush(numout)
+
+               !!======================================================================
+               !! LOCAL GRID CELL TRENDS
+               !!======================================================================
+               !!
+               !!----------------------------------------------------------------------
+               !! Determination of trends
+               !!----------------------------------------------------------------------
+               !!
+               !!----------------------------------------------------------------------
+               !! chlorophyll
+               btra(jpchn) = b0 * ( &
+                 + ((frn * fprn * zphn) - fgmipn - fgmepn - fdpn - fdpn2) * (fthetan / xxi) )
+               btra(jpchd) = b0 * ( &
+                 + ((frd * fprd * zphd) - fgmepd - fdpd - fdpd2) * (fthetad / xxi) )
+               !!
+               !!----------------------------------------------------------------------
+               !! phytoplankton
+               btra(jpphn) = b0 * ( &
+                 + (fprn * zphn) - fgmipn - fgmepn - fdpn - fdpn2 )
+               btra(jpphd) = b0 * ( &
+                 + (fprd * zphd) - fgmepd - fdpd - fdpd2 )
+               btra(jppds) = b0 * ( &
+                 + (fprds * zpds) - fgmepds - fdpds - fsdiss - fdpds2 )
+               !!
+               !!----------------------------------------------------------------------
+               !! zooplankton
+               btra(jpzmi) = b0 * ( &
+                 + fmigrow - fgmezmi - fdzmi - fdzmi2 )
+               btra(jpzme) = b0 * ( &
+                 + fmegrow - fdzme - fdzme2 )
+               !!
+               !!----------------------------------------------------------------------
+               !! detritus
+               btra(jpdet) = b0 * ( &
+                 + fdpn + ((1.0 - xfdfrac1) * fdpd)              &  ! mort. losses
+                 + fdzmi + ((1.0 - xfdfrac2) * fdzme)            &  ! mort. losses
+                 + ((1.0 - xbetan) * (finmi + finme))            &  ! assim. inefficiency
+                 - fgmid - fgmed - fdd                           &  ! grazing and remin.
+                 + ffast2slown )                                    ! seafloor fast->slow
+               !!
+               !!----------------------------------------------------------------------
+               !! dissolved inorganic nitrogen nutrient
+               fn_cons = 0.0  &
+                 - (fprn * zphn) - (fprd * zphd)                    ! primary production
+               fn_prod = 0.0  &
+                 + (xphi * (fgmipn + fgmid))                     &  ! messy feeding remin.
+                 + (xphi * (fgmepn + fgmepd + fgmezmi + fgmed))  &  ! messy feeding remin.
+                 + fmiexcr + fmeexcr + fdd + freminn             &  ! excretion and remin.
+                 + fdpn2 + fdpd2 + fdzmi2 + fdzme2                  ! metab. losses
+               !! 
+               !! riverine flux
+               if ( jriver_n .gt. 0 ) then
+                  f_riv_loc_n = f_riv_n(ji,jj) * friver_dep(jk,jmbathy) / fthk
+                  fn_prod = fn_prod + f_riv_loc_n
+               endif
+               !!  
+               !! benthic remineralisation
+               if (jk.eq.jmbathy .and. jorgben.eq.1 .and. ibenthic.eq.1) then
+                  fn_prod = fn_prod + (f_benout_n(ji,jj) / fthk)
+               endif
+               !!
+               btra(jpdin) = b0 * ( &
+                 fn_prod + fn_cons )
+               !!
+               fnit_cons(ji,jj) = fnit_cons(ji,jj) + ( fthk * (  &  ! consumption of dissolved nitrogen
+                 fn_cons ) )
+               fnit_prod(ji,jj) = fnit_prod(ji,jj) + ( fthk * (  &  ! production of dissolved nitrogen
+                 fn_prod ) )
+               !!
+               !!----------------------------------------------------------------------
+               !! dissolved silicic acid nutrient
+               fs_cons = 0.0  &
+                 - (fprds * zpds)                                   ! opal production
+               fs_prod = 0.0  &
+                 + fsdiss                                        &  ! opal dissolution
+                 + ((1.0 - xfdfrac1) * fdpds)                    &  ! mort. loss
+                 + ((1.0 - xfdfrac3) * fgmepds)                  &  ! egestion of grazed Si
+                 + freminsi + fdpds2                                ! fast diss. and metab. losses
+               !! 
+               !! riverine flux
+               if ( jriver_si .gt. 0 ) then
+                  f_riv_loc_si = f_riv_si(ji,jj) * friver_dep(jk,jmbathy) / fthk
+                  fs_prod = fs_prod + f_riv_loc_si
+               endif
+               !!  
+               !! benthic remineralisation
+               if (jk.eq.jmbathy .and. jinorgben.eq.1 .and. ibenthic.eq.1) then
+                  fs_prod = fs_prod + (f_benout_si(ji,jj) / fthk)
+               endif
+               !!
+               btra(jpsil) = b0 * ( &
+                 fs_prod + fs_cons )
+               !!
+               fsil_cons(ji,jj) = fsil_cons(ji,jj) + ( fthk * (  &  ! consumption of dissolved silicon
+                 fs_cons ) )
+               fsil_prod(ji,jj) = fsil_prod(ji,jj) + ( fthk * (  &  ! production of dissolved silicon
+                 fs_prod ) )
+               !!
+               !!----------------------------------------------------------------------
+               !! dissolved "iron" nutrient
+               btra(jpfer) = b0 * ( &
+               + (xrfn * btra(jpdin)) + ffetop + ffebot - ffescav )
+
+# if defined key_roam
+               !!
+               !!----------------------------------------------------------------------
+               !! AXY (26/11/08): implicit detrital carbon change
+               btra(jpdtc) = b0 * ( &
+                 + (xthetapn * fdpn) + ((1.0 - xfdfrac1) * (xthetapd * fdpd))      &  ! mort. losses
+                 + (xthetazmi * fdzmi) + ((1.0 - xfdfrac2) * (xthetazme * fdzme))  &  ! mort. losses
+                 + ((1.0 - xbetac) * (ficmi + ficme))                              &  ! assim. inefficiency
+                 - fgmidc - fgmedc - fddc                                          &  ! grazing and remin.
+                 + ffast2slowc )                                                      ! seafloor fast->slow
+               !!
+               !!----------------------------------------------------------------------
+               !! dissolved inorganic carbon
+               fc_cons = 0.0  &
+                 - (xthetapn * fprn * zphn) - (xthetapd * fprd * zphd)                ! primary production
+               fc_prod = 0.0  &
+                 + (xthetapn * xphi * fgmipn) + (xphi * fgmidc)                    &  ! messy feeding remin
+                 + (xthetapn * xphi * fgmepn) + (xthetapd * xphi * fgmepd)         &  ! messy feeding remin
+                 + (xthetazmi * xphi * fgmezmi) + (xphi * fgmedc)                  &  ! messy feeding remin
+                 + fmiresp + fmeresp + fddc + freminc + (xthetapn * fdpn2)         &  ! resp., remin., losses
+                 + (xthetapd * fdpd2) + (xthetazmi * fdzmi2)                       &  ! losses
+                 + (xthetazme * fdzme2)                                               ! losses
+               !! 
+               !! riverine flux
+               if ( jriver_c .gt. 0 ) then
+                  f_riv_loc_c = f_riv_c(ji,jj) * friver_dep(jk,jmbathy) / fthk
+                  fc_prod = fc_prod + f_riv_loc_c
+               endif
+               !!  
+               !! benthic remineralisation
+               if (jk.eq.jmbathy .and. jorgben.eq.1 .and. ibenthic.eq.1) then
+                  fc_prod = fc_prod + (f_benout_c(ji,jj) / fthk)
+               endif
+               if (jk.eq.jmbathy .and. jinorgben.eq.1 .and. ibenthic.eq.1) then
+                  fc_prod = fc_prod + (f_benout_ca(ji,jj) / fthk)
+               endif
+               !!
+               !! community respiration (does not include CaCO3 terms - obviously!)
+               fcomm_resp(ji,jj) = fcomm_resp(ji,jj) + fc_prod
+               !!
+               !! CaCO3
+               fc_prod = fc_prod - ftempca + freminca
+               !! 
+               !! riverine flux
+               if ( jk .eq. 1 .and. jriver_c .gt. 0 ) then
+                  fc_prod = fc_prod + f_riv_c(ji,jj)
+               endif
+               !!
+               btra(jpdic) = b0 * ( &
+                 fc_prod + fc_cons )
+               !!
+               fcar_cons(ji,jj) = fcar_cons(ji,jj) + ( fthk * (  &  ! consumption of dissolved carbon
+                 fc_cons ) )
+               fcar_prod(ji,jj) = fcar_prod(ji,jj) + ( fthk * (  &  ! production of dissolved carbon
+                 fc_prod ) )
+               !!
+               !!----------------------------------------------------------------------
+               !! alkalinity
+               fa_prod = 0.0  &
+                 + (2.0 * freminca)                                                   ! CaCO3 dissolution
+               fa_cons = 0.0  &
+                 - (2.0 * ftempca)                                                    ! CaCO3 production
+               !! 
+               !! riverine flux
+               if ( jriver_alk .gt. 0 ) then
+                  f_riv_loc_alk = f_riv_alk(ji,jj) * friver_dep(jk,jmbathy) / fthk
+                  fa_prod = fa_prod + f_riv_loc_alk
+               endif
+               !!  
+               !! benthic remineralisation
+               if (jk.eq.jmbathy .and. jinorgben.eq.1 .and. ibenthic.eq.1) then
+                  fa_prod = fa_prod + (2.0 * f_benout_ca(ji,jj) / fthk)
+               endif
+               !!
+               btra(jpalk) = b0 * ( &
+                 fa_prod + fa_cons )
+               !!
+               !!----------------------------------------------------------------------
+               !! oxygen (has protection at low O2 concentrations; OCMIP-2 style)
+               fo2_prod = 0.0 &
+                 + (xthetanit * fprn * zphn)                                      & ! Pn primary production, N
+                 + (xthetanit * fprd * zphd)                                      & ! Pd primary production, N
+                 + (xthetarem * xthetapn * fprn * zphn)                           & ! Pn primary production, C
+                 + (xthetarem * xthetapd * fprd * zphd)                             ! Pd primary production, C
+               fo2_ncons = 0.0 &
+                 - (xthetanit * xphi * fgmipn)                                    & ! Pn messy feeding remin., N
+                 - (xthetanit * xphi * fgmid)                                     & ! D  messy feeding remin., N
+                 - (xthetanit * xphi * fgmepn)                                    & ! Pn messy feeding remin., N
+                 - (xthetanit * xphi * fgmepd)                                    & ! Pd messy feeding remin., N
+                 - (xthetanit * xphi * fgmezmi)                                   & ! Zi messy feeding remin., N
+                 - (xthetanit * xphi * fgmed)                                     & ! D  messy feeding remin., N
+                 - (xthetanit * fmiexcr)                                          & ! microzoo excretion, N
+                 - (xthetanit * fmeexcr)                                          & ! mesozoo  excretion, N
+                 - (xthetanit * fdd)                                              & ! slow detritus remin., N 
+                 - (xthetanit * freminn)                                          & ! fast detritus remin., N
+                 - (xthetanit * fdpn2)                                            & ! Pn  losses, N
+                 - (xthetanit * fdpd2)                                            & ! Pd  losses, N
+                 - (xthetanit * fdzmi2)                                           & ! Zmi losses, N
+                 - (xthetanit * fdzme2)                                             ! Zme losses, N
+               !!  
+               !! benthic remineralisation
+               if (jk.eq.jmbathy .and. jorgben.eq.1 .and. ibenthic.eq.1) then
+                  fo2_ncons = fo2_ncons - (xthetanit * f_benout_n(ji,jj) / fthk)
+               endif
+               fo2_ccons = 0.0 &
+                 - (xthetarem * xthetapn * xphi * fgmipn)                         & ! Pn messy feeding remin., C
+                 - (xthetarem * xphi * fgmidc)                                    & ! D  messy feeding remin., C
+                 - (xthetarem * xthetapn * xphi * fgmepn)                         & ! Pn messy feeding remin., C
+                 - (xthetarem * xthetapd * xphi * fgmepd)                         & ! Pd messy feeding remin., C
+                 - (xthetarem * xthetazmi * xphi * fgmezmi)                       & ! Zi messy feeding remin., C
+                 - (xthetarem * xphi * fgmedc)                                    & ! D  messy feeding remin., C
+                 - (xthetarem * fmiresp)                                          & ! microzoo respiration, C
+                 - (xthetarem * fmeresp)                                          & ! mesozoo  respiration, C
+                 - (xthetarem * fddc)                                             & ! slow detritus remin., C
+                 - (xthetarem * freminc)                                          & ! fast detritus remin., C
+                 - (xthetarem * xthetapn * fdpn2)                                 & ! Pn  losses, C
+                 - (xthetarem * xthetapd * fdpd2)                                 & ! Pd  losses, C
+                 - (xthetarem * xthetazmi * fdzmi2)                               & ! Zmi losses, C
+                 - (xthetarem * xthetazme * fdzme2)                                 ! Zme losses, C
+               !!  
+               !! benthic remineralisation
+               if (jk.eq.jmbathy .and. jorgben.eq.1 .and. ibenthic.eq.1) then
+                  fo2_ccons = fo2_ccons - (xthetarem * f_benout_c(ji,jj) / fthk)
+               endif
+               fo2_cons = fo2_ncons + fo2_ccons
+               !!
+               !! is this a suboxic zone?
+               if (zoxy.lt.xo2min) then  ! deficient O2; production fluxes only
+                  btra(jpoxy) = b0 * ( &
+                    fo2_prod )
+                  foxy_prod(ji,jj) = foxy_prod(ji,jj) + ( fthk * fo2_prod )
+                  foxy_anox(ji,jj) = foxy_anox(ji,jj) + ( fthk * fo2_cons )
+               else                      ! sufficient O2; production + consumption fluxes
+                  btra(jpoxy) = b0 * ( &
+                    fo2_prod + fo2_cons )
+                  foxy_prod(ji,jj) = foxy_prod(ji,jj) + ( fthk * fo2_prod )
+                  foxy_cons(ji,jj) = foxy_cons(ji,jj) + ( fthk * fo2_cons )
+               endif
+               !!
+               !! air-sea fluxes (if this is the surface box)
+               if (jk.eq.1) then
+                  !!
+                  !! CO2 flux
+                  btra(jpdic) = btra(jpdic) + (b0 * f_co2flux)
+                  !!
+                  !! O2 flux (mol/m3/s -> mmol/m3/d)
+                  btra(jpoxy) = btra(jpoxy) + (b0 * f_o2flux)
+               endif
+# endif
+
+# if defined key_debug_medusa
+               !! report state variable fluxes (not including fast-sinking detritus)
+               if (idf.eq.1.AND.idfval.eq.1) then
+                  IF (lwp) write (numout,*) '------------------------------'
+                  IF (lwp) write (numout,*) 'btra(jpchn)(',jk,')  = ', btra(jpchn)
+                  IF (lwp) write (numout,*) 'btra(jpchd)(',jk,')  = ', btra(jpchd)
+                  IF (lwp) write (numout,*) 'btra(jpphn)(',jk,')  = ', btra(jpphn)
+                  IF (lwp) write (numout,*) 'btra(jpphd)(',jk,')  = ', btra(jpphd)
+                  IF (lwp) write (numout,*) 'btra(jppds)(',jk,')  = ', btra(jppds)
+                  IF (lwp) write (numout,*) 'btra(jpzmi)(',jk,')  = ', btra(jpzmi)
+                  IF (lwp) write (numout,*) 'btra(jpzme)(',jk,')  = ', btra(jpzme)
+                  IF (lwp) write (numout,*) 'btra(jpdet)(',jk,')  = ', btra(jpdet)
+                  IF (lwp) write (numout,*) 'btra(jpdin)(',jk,')  = ', btra(jpdin)
+                  IF (lwp) write (numout,*) 'btra(jpsil)(',jk,')  = ', btra(jpsil)
+                  IF (lwp) write (numout,*) 'btra(jpfer)(',jk,')  = ', btra(jpfer)
+#  if defined key_roam
+                  IF (lwp) write (numout,*) 'btra(jpdtc)(',jk,')  = ', btra(jpdtc)
+                  IF (lwp) write (numout,*) 'btra(jpdic)(',jk,')  = ', btra(jpdic)
+                  IF (lwp) write (numout,*) 'btra(jpalk)(',jk,')  = ', btra(jpalk)
+                  IF (lwp) write (numout,*) 'btra(jpoxy)(',jk,')  = ', btra(jpoxy)
+#  endif
+               endif
+# endif
+
+               !!----------------------------------------------------------------------
+               !! Integrate calculated fluxes for mass balance
+               !!----------------------------------------------------------------------
+               !!
+               !! === nitrogen ===
+               fflx_n(ji,jj)  = fflx_n(ji,jj)  + &
+                  fthk * ( btra(jpphn) + btra(jpphd) + btra(jpzmi) + btra(jpzme) + btra(jpdet) + btra(jpdin) )
+               !! === silicon ===
+               fflx_si(ji,jj) = fflx_si(ji,jj) + &
+                  fthk * ( btra(jppds) + btra(jpsil) )
+               !! === iron ===
+               fflx_fe(ji,jj) = fflx_fe(ji,jj) + &
+                  fthk * ( ( xrfn * ( btra(jpphn) + btra(jpphd) + btra(jpzmi) + btra(jpzme) + btra(jpdet)) ) + btra(jpfer) )
+# if defined key_roam
+               !! === carbon ===
+               fflx_c(ji,jj)  = fflx_c(ji,jj)  + &
+                  fthk * ( (xthetapn * btra(jpphn)) + (xthetapd * btra(jpphd)) + &
+                  (xthetazmi * btra(jpzmi)) + (xthetazme * btra(jpzme)) + btra(jpdtc) + btra(jpdic) )
+               !! === alkalinity ===
+               fflx_a(ji,jj)  = fflx_a(ji,jj)  + &
+                  fthk * ( btra(jpalk) )
+               !! === oxygen ===
+               fflx_o2(ji,jj) = fflx_o2(ji,jj) + &
+                  fthk * ( btra(jpoxy) )
+# endif
+
+               !!----------------------------------------------------------------------
+               !! Apply calculated tracer fluxes
+               !!----------------------------------------------------------------------
+               !!
+               !! units: [unit of tracer] per second (fluxes are calculated above per day)
+               !!
+               ibio_switch = 1
+# if defined key_gulf_finland
+               !! AXY (17/05/13): fudge in a Gulf of Finland correction; uses longitude-
+               !!                 latitude range to establish if this is a Gulf of Finland 
+               !!                 grid cell; if so, then BGC fluxes are ignored (though 
+               !!                 still calculated); for reference, this is meant to be a 
+               !!                 temporary fix to see if all of my problems can be done 
+               !!                 away with if I switch off BGC fluxes in the Gulf of 
+               !!                 Finland, which currently appears the source of trouble
+               if ( glamt(ji,jj).gt.24.7 .and. glamt(ji,jj).lt.27.8 .and. &
+                  &   gphit(ji,jj).gt.59.2 .and. gphit(ji,jj).lt.60.2 ) then
+                  ibio_switch = 0
+               endif
+# endif               
+               if (ibio_switch.eq.1) then
+                  tra(ji,jj,jk,jpchn) = tra(ji,jj,jk,jpchn) + (btra(jpchn) / 86400.)
+                  tra(ji,jj,jk,jpchd) = tra(ji,jj,jk,jpchd) + (btra(jpchd) / 86400.)
+                  tra(ji,jj,jk,jpphn) = tra(ji,jj,jk,jpphn) + (btra(jpphn) / 86400.)
+                  tra(ji,jj,jk,jpphd) = tra(ji,jj,jk,jpphd) + (btra(jpphd) / 86400.)
+                  tra(ji,jj,jk,jppds) = tra(ji,jj,jk,jppds) + (btra(jppds) / 86400.)
+                  tra(ji,jj,jk,jpzmi) = tra(ji,jj,jk,jpzmi) + (btra(jpzmi) / 86400.)
+                  tra(ji,jj,jk,jpzme) = tra(ji,jj,jk,jpzme) + (btra(jpzme) / 86400.)
+                  tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + (btra(jpdet) / 86400.)
+                  tra(ji,jj,jk,jpdin) = tra(ji,jj,jk,jpdin) + (btra(jpdin) / 86400.)
+                  tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) + (btra(jpsil) / 86400.)
+                  tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + (btra(jpfer) / 86400.)
+# if defined key_roam
+                  tra(ji,jj,jk,jpdtc) = tra(ji,jj,jk,jpdtc) + (btra(jpdtc) / 86400.)
+                  tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + (btra(jpdic) / 86400.)
+                  tra(ji,jj,jk,jpalk) = tra(ji,jj,jk,jpalk) + (btra(jpalk) / 86400.)
+                  tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + (btra(jpoxy) / 86400.)
+# endif
+               endif               
+
+               !! AXY (18/11/16): CMIP6 diagnostics
+               IF( med_diag%FBDDTALK%dgsave )  THEN
+                  fbddtalk(ji,jj)  =  fbddtalk(ji,jj)  + (btra(jpalk) * fthk)
+               ENDIF
+               IF( med_diag%FBDDTDIC%dgsave )  THEN
+                  fbddtdic(ji,jj)  =  fbddtdic(ji,jj)  + (btra(jpdic) * fthk)
+               ENDIF
+               IF( med_diag%FBDDTDIFE%dgsave ) THEN
+                  fbddtdife(ji,jj) =  fbddtdife(ji,jj) + (btra(jpfer) * fthk)
+               ENDIF
+               IF( med_diag%FBDDTDIN%dgsave )  THEN
+                  fbddtdin(ji,jj)  =  fbddtdin(ji,jj)  + (btra(jpdin) * fthk)
+               ENDIF
+               IF( med_diag%FBDDTDISI%dgsave ) THEN
+                  fbddtdisi(ji,jj) =  fbddtdisi(ji,jj) + (btra(jpsil) * fthk)
+               ENDIF
+	       !!
+               IF( med_diag%BDDTALK3%dgsave )  THEN
+                  bddtalk3(ji,jj,jk)  =  btra(jpalk)
+               ENDIF
+               IF( med_diag%BDDTDIC3%dgsave )  THEN
+                  bddtdic3(ji,jj,jk)  =  btra(jpdic)
+               ENDIF
+               IF( med_diag%BDDTDIFE3%dgsave ) THEN
+                  bddtdife3(ji,jj,jk) =  btra(jpfer)
+               ENDIF
+               IF( med_diag%BDDTDIN3%dgsave )  THEN
+                  bddtdin3(ji,jj,jk)  =  btra(jpdin)
+               ENDIF
+               IF( med_diag%BDDTDISI3%dgsave ) THEN
+                  bddtdisi3(ji,jj,jk) =  btra(jpsil)
+               ENDIF
+
+#   if defined key_debug_medusa
+               IF (lwp) write (numout,*) '------'
+               IF (lwp) write (numout,*) 'trc_bio_medusa: end all calculations'
+               IF (lwp) write (numout,*) 'trc_bio_medusa: now outputs'
+                     CALL flush(numout)
+#   endif
+
+# if defined key_axy_nancheck
+               !!----------------------------------------------------------------------
+               !! Check calculated tracer fluxes
+               !!----------------------------------------------------------------------
+               !!
+               DO jn = 1,jptra
+                  fq0 = btra(jn)
+                  !! AXY (30/01/14): "isnan" problem on HECTOR
+                  !! if (fq0 /= fq0 ) then
+                  if ( ieee_is_nan( fq0 ) ) then
+                     !! there's a NaN here
+                     if (lwp) write(numout,*) 'NAN detected in btra(', ji, ',', &
+                     & jj, ',', jk, ',', jn, ') at time', kt
+		     CALL ctl_stop( 'trcbio_medusa, NAN in btra field' )
+                  endif
+               ENDDO
+               DO jn = 1,jptra
+                  fq0 = tra(ji,jj,jk,jn)
+                  !! AXY (30/01/14): "isnan" problem on HECTOR
+                  !! if (fq0 /= fq0 ) then
+                  if ( ieee_is_nan( fq0 ) ) then
+                     !! there's a NaN here
+                     if (lwp) write(numout,*) 'NAN detected in tra(', ji, ',', &
+                     & jj, ',', jk, ',', jn, ') at time', kt
+   		     CALL ctl_stop( 'trcbio_medusa, NAN in tra field' )
+                  endif
+               ENDDO
+               CALL flush(numout)
+# endif
+
+               !!----------------------------------------------------------------------
+               !! Check model conservation
+               !! these terms merely sum up the tendency terms of the relevant
+               !! state variables, which should sum to zero; the iron cycle is
+               !! complicated by fluxes that add (aeolian deposition and seafloor
+               !! remineralisation) and remove (scavenging) dissolved iron from
+               !! the model (i.e. the sum of iron fluxes is unlikely to be zero)
+               !!----------------------------------------------------------------------
+               !!
+               !! fnit0 = btra(jpphn) + btra(jpphd) + btra(jpzmi) + btra(jpzme) + btra(jpdet) + btra(jpdin)  ! + ftempn
+               !! fsil0 = btra(jppds) + btra(jpsil)                              ! + ftempsi
+               !! ffer0 = (xrfn * fnit0) + btra(jpfer)
+# if defined key_roam
+               !! fcar0 = 0.
+               !! falk0 = 0.
+               !! foxy0 = 0.
+# endif
+               !!
+               !! if (kt/240*240.eq.kt) then
+               !!    if (ji.eq.2.and.jj.eq.2.and.jk.eq.1) then
+               !!       IF (lwp) write (*,*) '*******!MEDUSA Conservation!*******',kt
+# if defined key_roam
+               !!       IF (lwp) write (*,*) fnit0,fsil0,ffer0,fcar0,falk0,foxy0
+# else
+               !!       IF (lwp) write (*,*) fnit0,fsil0,ffer0
+# endif
+               !!    endif
+               !! endif     
+
+# if defined key_trc_diabio
+               !!======================================================================
+               !! LOCAL GRID CELL DIAGNOSTICS
+               !!======================================================================
+               !!
+               !!----------------------------------------------------------------------
+               !! Full diagnostics key_trc_diabio:
+               !! LOBSTER and PISCES support full diagnistics option key_trc_diabio    
+               !! which gives an option of FULL output of biological sourses and sinks.
+               !! I cannot see any reason for doing this. If needed, it can be done
+               !! as shown below.
+               !!----------------------------------------------------------------------
+               !!
+               IF(lwp) WRITE(numout,*) ' MEDUSA does not support key_trc_diabio'
+               !!               trbio(ji,jj,jk, 1) = fprn
+# endif
+
+               IF( lk_iomput  .AND.  .NOT.  ln_diatrc  ) THEN
+         !!----------------------------------------------------------------------
+         !! Add in XML diagnostics stuff
+         !!----------------------------------------------------------------------
+         !!
+         !! ** 2D diagnostics
+#   if defined key_debug_medusa
+                  IF (lwp) write (numout,*) 'trc_bio_medusa: diag in ij-jj-jk loop'
+                  CALL flush(numout)
+#   endif
+                  IF ( med_diag%PRN%dgsave ) THEN
+                      fprn2d(ji,jj) = fprn2d(ji,jj) + (fprn  * zphn * fthk) 
+                  ENDIF
+                  IF ( med_diag%MPN%dgsave ) THEN
+                      fdpn2d(ji,jj) = fdpn2d(ji,jj) + (fdpn         * fthk)
+                  ENDIF
+                  IF ( med_diag%PRD%dgsave ) THEN
+                      fprd2d(ji,jj) = fprd2d(ji,jj) + (fprd  * zphd * fthk)
+                  ENDIF
+                  IF( med_diag%MPD%dgsave ) THEN
+                      fdpd2d(ji,jj) = fdpd2d(ji,jj) + (fdpd         * fthk) 
+                  ENDIF
+                  !  IF( med_diag%DSED%dgsave ) THEN
+                  !      CALL iom_put( "DSED"  , ftot_n )
+                  !  ENDIF
+                  IF( med_diag%OPAL%dgsave ) THEN
+                      fprds2d(ji,jj) = fprds2d(ji,jj) + (fprds * zpds * fthk) 
+                  ENDIF
+                  IF( med_diag%OPALDISS%dgsave ) THEN
+                      fsdiss2d(ji,jj) = fsdiss2d(ji,jj) + (fsdiss  * fthk)  
+                  ENDIF
+                  IF( med_diag%GMIPn%dgsave ) THEN
+                      fgmipn2d(ji,jj) = fgmipn2d(ji,jj) + (fgmipn  * fthk) 
+                  ENDIF
+                  IF( med_diag%GMID%dgsave ) THEN
+                      fgmid2d(ji,jj) = fgmid2d(ji,jj) + (fgmid   * fthk) 
+                  ENDIF
+                  IF( med_diag%MZMI%dgsave ) THEN
+                      fdzmi2d(ji,jj) = fdzmi2d(ji,jj) + (fdzmi   * fthk) 
+                  ENDIF
+                  IF( med_diag%GMEPN%dgsave ) THEN
+                      fgmepn2d(ji,jj) = fgmepn2d(ji,jj) + (fgmepn  * fthk)
+                  ENDIF
+                  IF( med_diag%GMEPD%dgsave ) THEN
+                      fgmepd2d(ji,jj) = fgmepd2d(ji,jj) + (fgmepd  * fthk) 
+                  ENDIF
+                  IF( med_diag%GMEZMI%dgsave ) THEN
+                      fgmezmi2d(ji,jj) = fgmezmi2d(ji,jj) + (fgmezmi * fthk) 
+                  ENDIF
+                  IF( med_diag%GMED%dgsave ) THEN
+                      fgmed2d(ji,jj) = fgmed2d(ji,jj) + (fgmed   * fthk) 
+                  ENDIF
+                  IF( med_diag%MZME%dgsave ) THEN
+                      fdzme2d(ji,jj) = fdzme2d(ji,jj) + (fdzme   * fthk) 
+                  ENDIF
+                  !  IF( med_diag%DEXP%dgsave ) THEN
+                  !      CALL iom_put( "DEXP"  , ftot_n )
+                  !  ENDIF
+                  IF( med_diag%DETN%dgsave ) THEN
+                      fslown2d(ji,jj) = fslown2d(ji,jj) + (fslown  * fthk)  
+                  ENDIF
+                  IF( med_diag%MDET%dgsave ) THEN
+                      fdd2d(ji,jj) = fdd2d(ji,jj) + (fdd     * fthk) 
+                  ENDIF
+                  IF( med_diag%AEOLIAN%dgsave ) THEN
+                      ffetop2d(ji,jj) = ffetop2d(ji,jj) + (ffetop  * fthk) 
+                  ENDIF
+                  IF( med_diag%BENTHIC%dgsave ) THEN
+                      ffebot2d(ji,jj) = ffebot2d(ji,jj) + (ffebot  * fthk) 
+                  ENDIF
+                  IF( med_diag%SCAVENGE%dgsave ) THEN
+                      ffescav2d(ji,jj) = ffescav2d(ji,jj) + (ffescav * fthk)  
+                  ENDIF
+                  IF( med_diag%PN_JLIM%dgsave ) THEN
+                      ! fjln2d(ji,jj) = fjln2d(ji,jj) + (fjln  * zphn * fthk) 
+                      fjln2d(ji,jj) = fjln2d(ji,jj) + (fjlim_pn * zphn * fthk) 
+                  ENDIF
+                  IF( med_diag%PN_NLIM%dgsave ) THEN
+                      fnln2d(ji,jj) = fnln2d(ji,jj) + (fnln  * zphn * fthk) 
+                  ENDIF
+                  IF( med_diag%PN_FELIM%dgsave ) THEN
+                      ffln2d(ji,jj) = ffln2d(ji,jj) + (ffln  * zphn * fthk) 
+                  ENDIF
+                  IF( med_diag%PD_JLIM%dgsave ) THEN
+                      ! fjld2d(ji,jj) = fjld2d(ji,jj) + (fjld  * zphd * fthk) 
+                      fjld2d(ji,jj) = fjld2d(ji,jj) + (fjlim_pd * zphd * fthk) 
+                  ENDIF
+                  IF( med_diag%PD_NLIM%dgsave ) THEN
+                      fnld2d(ji,jj) = fnld2d(ji,jj) + (fnld  * zphd * fthk) 
+                  ENDIF
+                  IF( med_diag%PD_FELIM%dgsave ) THEN
+                      ffld2d(ji,jj) = ffld2d(ji,jj) + (ffld  * zphd * fthk) 
+                  ENDIF
+                  IF( med_diag%PD_SILIM%dgsave ) THEN
+                      fsld2d2(ji,jj) = fsld2d2(ji,jj) + (fsld2 * zphd * fthk) 
+                  ENDIF
+                  IF( med_diag%PDSILIM2%dgsave ) THEN
+                      fsld2d(ji,jj) = fsld2d(ji,jj) + (fsld  * zphd * fthk)
+                  ENDIF
+                  !! 
+                  IF( med_diag%TOTREG_N%dgsave ) THEN
+                      fregen2d(ji,jj) = fregen2d(ji,jj) + fregen
+                  ENDIF
+                  IF( med_diag%TOTRG_SI%dgsave ) THEN
+                      fregensi2d(ji,jj) = fregensi2d(ji,jj) + fregensi
+                  ENDIF
+                  !! 
+                  IF( med_diag%FASTN%dgsave ) THEN
+                      ftempn2d(ji,jj) = ftempn2d(ji,jj) + (ftempn  * fthk)
+                  ENDIF
+                  IF( med_diag%FASTSI%dgsave ) THEN
+                      ftempsi2d(ji,jj) = ftempsi2d(ji,jj) + (ftempsi * fthk)
+                  ENDIF
+                  IF( med_diag%FASTFE%dgsave ) THEN
+                      ftempfe2d(ji,jj) =ftempfe2d(ji,jj)  + (ftempfe * fthk)  
+                  ENDIF
+                  IF( med_diag%FASTC%dgsave ) THEN
+                      ftempc2d(ji,jj) = ftempc2d(ji,jj) + (ftempc  * fthk)
+                  ENDIF
+                  IF( med_diag%FASTCA%dgsave ) THEN
+                      ftempca2d(ji,jj) = ftempca2d(ji,jj) + (ftempca * fthk)
+                  ENDIF
+                  !! 
+                  IF( med_diag%REMINN%dgsave ) THEN
+                      freminn2d(ji,jj) = freminn2d(ji,jj) + (freminn  * fthk)
+                  ENDIF
+                  IF( med_diag%REMINSI%dgsave ) THEN
+                      freminsi2d(ji,jj) = freminsi2d(ji,jj) + (freminsi * fthk)
+                  ENDIF
+                  IF( med_diag%REMINFE%dgsave ) THEN
+                      freminfe2d(ji,jj)= freminfe2d(ji,jj) + (freminfe * fthk) 
+                  ENDIF
+                  IF( med_diag%REMINC%dgsave ) THEN
+                      freminc2d(ji,jj) = freminc2d(ji,jj) + (freminc  * fthk) 
+                  ENDIF
+                  IF( med_diag%REMINCA%dgsave ) THEN
+                      freminca2d(ji,jj) = freminca2d(ji,jj) + (freminca * fthk) 
+                  ENDIF
+                  !!
+# if defined key_roam
+                  !!
+                  !! AXY (09/11/16): CMIP6 diagnostics
+                  IF( med_diag%FD_NIT3%dgsave ) THEN
+                     fd_nit3(ji,jj,jk) = ffastn(ji,jj)
+                  ENDIF
+                  IF( med_diag%FD_SIL3%dgsave ) THEN
+                     fd_sil3(ji,jj,jk) = ffastsi(ji,jj)
+                  ENDIF
+                  IF( med_diag%FD_CAR3%dgsave ) THEN
+                     fd_car3(ji,jj,jk) = ffastc(ji,jj)
+                  ENDIF
+                  IF( med_diag%FD_CAL3%dgsave ) THEN
+                     fd_cal3(ji,jj,jk) = ffastca(ji,jj)
+                  ENDIF
+                  !!
+                  IF (jk.eq.i0100) THEN
+                     IF( med_diag%RR_0100%dgsave ) THEN
+                        ffastca2d(ji,jj) =   &
+                        ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall)
+                     ENDIF                     
+                  ELSE IF (jk.eq.i0500) THEN 
+                     IF( med_diag%RR_0500%dgsave ) THEN
+                        ffastca2d(ji,jj) =   &
+                        ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall)
+                     ENDIF                        
+                  ELSE IF (jk.eq.i1000) THEN
+                     IF( med_diag%RR_1000%dgsave ) THEN
+                        ffastca2d(ji,jj) =   &
+                        ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall)
+                     ENDIF
+                  ELSE IF (jk.eq.jmbathy) THEN
+                     IF( med_diag%IBEN_N%dgsave ) THEN
+                        iben_n2d(ji,jj) = f_sbenin_n(ji,jj)  + f_fbenin_n(ji,jj)
+                     ENDIF
+                     IF( med_diag%IBEN_FE%dgsave ) THEN
+                        iben_fe2d(ji,jj) = f_sbenin_fe(ji,jj) + f_fbenin_fe(ji,jj)
+                     ENDIF
+                     IF( med_diag%IBEN_C%dgsave ) THEN
+                        iben_c2d(ji,jj) = f_sbenin_c(ji,jj)  + f_fbenin_c(ji,jj)
+                     ENDIF
+                     IF( med_diag%IBEN_SI%dgsave ) THEN
+                        iben_si2d(ji,jj) = f_fbenin_si(ji,jj)
+                     ENDIF
+                     IF( med_diag%IBEN_CA%dgsave ) THEN
+                        iben_ca2d(ji,jj) = f_fbenin_ca(ji,jj)
+                     ENDIF
+                     IF( med_diag%OBEN_N%dgsave ) THEN
+                        oben_n2d(ji,jj) = f_benout_n(ji,jj)
+                     ENDIF
+                     IF( med_diag%OBEN_FE%dgsave ) THEN
+                        oben_fe2d(ji,jj) = f_benout_fe(ji,jj)
+                     ENDIF
+                     IF( med_diag%OBEN_C%dgsave ) THEN
+                        oben_c2d(ji,jj) = f_benout_c(ji,jj)
+                     ENDIF
+                     IF( med_diag%OBEN_SI%dgsave ) THEN
+                        oben_si2d(ji,jj) = f_benout_si(ji,jj)
+                     ENDIF
+                     IF( med_diag%OBEN_CA%dgsave ) THEN
+                        oben_ca2d(ji,jj) = f_benout_ca(ji,jj)
+                     ENDIF
+                     IF( med_diag%SFR_OCAL%dgsave ) THEN
+                        sfr_ocal2d(ji,jj) = f3_omcal(ji,jj,jk)
+                     ENDIF
+                     IF( med_diag%SFR_OARG%dgsave ) THEN
+                        sfr_oarg2d(ji,jj) =  f3_omarg(ji,jj,jk)
+                     ENDIF
+                     IF( med_diag%LYSO_CA%dgsave ) THEN
+                        lyso_ca2d(ji,jj) = f_benout_lyso_ca(ji,jj)
+                     ENDIF
+                  ENDIF
+                  !! end bathy-1 diags
+                  !!
+                  IF( med_diag%RIV_N%dgsave ) THEN
+                     rivn2d(ji,jj) = rivn2d(ji,jj) +  (f_riv_loc_n * fthk)
+                  ENDIF
+                  IF( med_diag%RIV_SI%dgsave ) THEN
+                     rivsi2d(ji,jj) = rivsi2d(ji,jj) +  (f_riv_loc_si * fthk)
+                  ENDIF
+                  IF( med_diag%RIV_C%dgsave ) THEN
+                     rivc2d(ji,jj) = rivc2d(ji,jj) +  (f_riv_loc_c * fthk)
+                  ENDIF
+                  IF( med_diag%RIV_ALK%dgsave ) THEN
+                     rivalk2d(ji,jj) = rivalk2d(ji,jj) +  (f_riv_loc_alk * fthk)
+                  ENDIF
+                  IF( med_diag%DETC%dgsave ) THEN
+                     fslowc2d(ji,jj) = fslowc2d(ji,jj) + (fslowc  * fthk)   
+                  ENDIF
+                  !! 
+                  !!              
+                  !!
+                  IF( med_diag%PN_LLOSS%dgsave ) THEN
+                     fdpn22d(ji,jj) = fdpn22d(ji,jj) + (fdpn2  * fthk)
+                  ENDIF
+                  IF( med_diag%PD_LLOSS%dgsave ) THEN
+                     fdpd22d(ji,jj) = fdpd22d(ji,jj) + (fdpd2  * fthk)
+                  ENDIF
+                  IF( med_diag%ZI_LLOSS%dgsave ) THEN
+                     fdzmi22d(ji,jj) = fdzmi22d(ji,jj) + (fdzmi2 * fthk)
+                  ENDIF
+                  IF( med_diag%ZE_LLOSS%dgsave ) THEN
+                     fdzme22d(ji,jj) = fdzme22d(ji,jj) + (fdzme2 * fthk)
+                  ENDIF
+                  IF( med_diag%ZI_MES_N%dgsave ) THEN
+                     zimesn2d(ji,jj) = zimesn2d(ji,jj) +  &
+                     (xphi * (fgmipn + fgmid) * fthk)
+                  ENDIF
+                  IF( med_diag%ZI_MES_D%dgsave ) THEN
+                     zimesd2d(ji,jj) = zimesd2d(ji,jj) + & 
+                     ((1. - xbetan) * finmi * fthk)
+                  ENDIF
+                  IF( med_diag%ZI_MES_C%dgsave ) THEN
+                     zimesc2d(ji,jj) = zimesc2d(ji,jj) + &
+                     (xphi * ((xthetapn * fgmipn) + fgmidc) * fthk)
+                  ENDIF
+                  IF( med_diag%ZI_MESDC%dgsave ) THEN
+                     zimesdc2d(ji,jj) = zimesdc2d(ji,jj) + &
+                     ((1. - xbetac) * ficmi * fthk)
+                  ENDIF
+                  IF( med_diag%ZI_EXCR%dgsave ) THEN
+                     ziexcr2d(ji,jj) = ziexcr2d(ji,jj) +  (fmiexcr * fthk)
+                  ENDIF
+                  IF( med_diag%ZI_RESP%dgsave ) THEN
+                     ziresp2d(ji,jj) = ziresp2d(ji,jj) +  (fmiresp * fthk)
+                  ENDIF
+                  IF( med_diag%ZI_GROW%dgsave ) THEN
+                     zigrow2d(ji,jj) = zigrow2d(ji,jj) + (fmigrow * fthk)
+                  ENDIF
+                  IF( med_diag%ZE_MES_N%dgsave ) THEN
+                     zemesn2d(ji,jj) = zemesn2d(ji,jj) + &
+                     (xphi * (fgmepn + fgmepd + fgmezmi + fgmed) * fthk)
+                  ENDIF
+                  IF( med_diag%ZE_MES_D%dgsave ) THEN
+                     zemesd2d(ji,jj) = zemesd2d(ji,jj) + &
+                     ((1. - xbetan) * finme * fthk)
+                  ENDIF
+                  IF( med_diag%ZE_MES_C%dgsave ) THEN
+                     zemesc2d(ji,jj) = zemesc2d(ji,jj) +                         & 
+                     (xphi * ((xthetapn * fgmepn) + (xthetapd * fgmepd) +  &
+                     (xthetazmi * fgmezmi) + fgmedc) * fthk)
+                  ENDIF
+                  IF( med_diag%ZE_MESDC%dgsave ) THEN
+                     zemesdc2d(ji,jj) = zemesdc2d(ji,jj) +  &
+                     ((1. - xbetac) * ficme * fthk)
+                  ENDIF
+                  IF( med_diag%ZE_EXCR%dgsave ) THEN
+                     zeexcr2d(ji,jj) = zeexcr2d(ji,jj) + (fmeexcr * fthk)
+                  ENDIF
+                  IF( med_diag%ZE_RESP%dgsave ) THEN
+                     zeresp2d(ji,jj) = zeresp2d(ji,jj) + (fmeresp * fthk)
+                  ENDIF
+                  IF( med_diag%ZE_GROW%dgsave ) THEN
+                     zegrow2d(ji,jj) = zegrow2d(ji,jj) + (fmegrow * fthk)
+                  ENDIF
+                  IF( med_diag%MDETC%dgsave ) THEN
+                     mdetc2d(ji,jj) = mdetc2d(ji,jj) + (fddc * fthk)
+                  ENDIF
+                  IF( med_diag%GMIDC%dgsave ) THEN
+                     gmidc2d(ji,jj) = gmidc2d(ji,jj) + (fgmidc * fthk)
+                  ENDIF
+                  IF( med_diag%GMEDC%dgsave ) THEN
+                     gmedc2d(ji,jj) = gmedc2d(ji,jj) + (fgmedc  * fthk)
+                  ENDIF
+                  !!
+# endif                   
+                  !!
+                  !! ** 3D diagnostics
+                  IF( med_diag%TPP3%dgsave ) THEN
+                     tpp3d(ji,jj,jk) =  (fprn * zphn) + (fprd * zphd)
+                     !CALL iom_put( "TPP3"  , tpp3d )
+                  ENDIF
+                  IF( med_diag%TPPD3%dgsave ) THEN
+                     tppd3(ji,jj,jk) =  (fprd * zphd)
+                  ENDIF
+                  
+                  IF( med_diag%REMIN3N%dgsave ) THEN
+                     remin3dn(ji,jj,jk) = fregen + (freminn * fthk) !! remineralisation
+                     !CALL iom_put( "REMIN3N"  , remin3dn )
+                  ENDIF
+                  !! IF( med_diag%PH3%dgsave ) THEN
+                  !!     CALL iom_put( "PH3"  , f3_pH )
+                  !! ENDIF
+                  !! IF( med_diag%OM_CAL3%dgsave ) THEN
+                  !!     CALL iom_put( "OM_CAL3"  , f3_omcal )
+                  !! ENDIF
+		  !! 
+		  !! AXY (09/11/16): CMIP6 diagnostics
+		  IF ( med_diag%DCALC3%dgsave   ) THEN
+                     dcalc3(ji,jj,jk) = freminca
+                  ENDIF
+		  IF ( med_diag%FEDISS3%dgsave  ) THEN
+                     fediss3(ji,jj,jk) = ffetop
+                  ENDIF
+		  IF ( med_diag%FESCAV3%dgsave  ) THEN
+                     fescav3(ji,jj,jk) = ffescav
+                  ENDIF
+		  IF ( med_diag%MIGRAZP3%dgsave ) THEN
+                     migrazp3(ji,jj,jk) = fgmipn * xthetapn
+                  ENDIF
+		  IF ( med_diag%MIGRAZD3%dgsave ) THEN
+                     migrazd3(ji,jj,jk) = fgmidc
+                  ENDIF
+		  IF ( med_diag%MEGRAZP3%dgsave ) THEN
+                     megrazp3(ji,jj,jk) = (fgmepn * xthetapn) + (fgmepd * xthetapd)
+                  ENDIF
+		  IF ( med_diag%MEGRAZD3%dgsave ) THEN
+                     megrazd3(ji,jj,jk) = fgmedc
+                  ENDIF
+		  IF ( med_diag%MEGRAZZ3%dgsave ) THEN
+                     megrazz3(ji,jj,jk) = (fgmezmi * xthetazmi)
+                  ENDIF
+		  IF ( med_diag%PBSI3%dgsave    ) THEN
+                     pbsi3(ji,jj,jk)    = (fprds * zpds)
+                  ENDIF
+		  IF ( med_diag%PCAL3%dgsave    ) THEN
+                     pcal3(ji,jj,jk)    = ftempca
+                  ENDIF
+		  IF ( med_diag%REMOC3%dgsave   ) THEN
+                     remoc3(ji,jj,jk)   = freminc
+                  ENDIF
+		  IF ( med_diag%PNLIMJ3%dgsave  ) THEN
+                     ! pnlimj3(ji,jj,jk)  = fjln
+                     pnlimj3(ji,jj,jk)  = fjlim_pn
+                  ENDIF
+		  IF ( med_diag%PNLIMN3%dgsave  ) THEN
+                     pnlimn3(ji,jj,jk)  = fnln
+                  ENDIF
+		  IF ( med_diag%PNLIMFE3%dgsave ) THEN
+                     pnlimfe3(ji,jj,jk) = ffln
+                  ENDIF
+		  IF ( med_diag%PDLIMJ3%dgsave  ) THEN
+                     ! pdlimj3(ji,jj,jk)  = fjld
+                     pdlimj3(ji,jj,jk)  = fjlim_pd
+                  ENDIF
+		  IF ( med_diag%PDLIMN3%dgsave  ) THEN
+                     pdlimn3(ji,jj,jk)  = fnld
+                  ENDIF
+		  IF ( med_diag%PDLIMFE3%dgsave ) THEN
+                     pdlimfe3(ji,jj,jk) = ffld
+                  ENDIF
+		  IF ( med_diag%PDLIMSI3%dgsave ) THEN
+                     pdlimsi3(ji,jj,jk) = fsld2
+                  ENDIF
+                  !!
+                  !! ** Without using iom_use
+               ELSE IF( ln_diatrc ) THEN
+#   if defined key_debug_medusa
+                  IF (lwp) write (numout,*) 'trc_bio_medusa: diag in ij-jj-jk ln_diatrc'
+                  CALL flush(numout)
+#   endif
+                  !!----------------------------------------------------------------------
+                  !! Prepare 2D diagnostics
+                  !!----------------------------------------------------------------------
+                  !!
+                  !! if ((kt / 240*240).eq.kt) then
+                  !!    IF (lwp) write (*,*) '*******!MEDUSA DIAADD!*******',kt
+                  !! endif     
+                  trc2d(ji,jj,1)  =  ftot_n(ji,jj)                             !! nitrogen inventory
+                  trc2d(ji,jj,2)  =  ftot_si(ji,jj)                            !! silicon  inventory
+                  trc2d(ji,jj,3)  =  ftot_fe(ji,jj)                            !! iron     inventory
+                  trc2d(ji,jj,4)  = trc2d(ji,jj,4)  + (fprn  * zphn * fthk)    !! non-diatom production
+                  trc2d(ji,jj,5)  = trc2d(ji,jj,5)  + (fdpn         * fthk)    !! non-diatom non-grazing losses
+                  trc2d(ji,jj,6)  = trc2d(ji,jj,6)  + (fprd  * zphd * fthk)    !! diatom production
+                  trc2d(ji,jj,7)  = trc2d(ji,jj,7)  + (fdpd         * fthk)    !! diatom non-grazing losses
+                  !! diagnostic field  8 is (ostensibly) supplied by trcsed.F            
+                  trc2d(ji,jj,9)  = trc2d(ji,jj,9)  + (fprds * zpds * fthk)    !! diatom silicon production
+                  trc2d(ji,jj,10) = trc2d(ji,jj,10) + (fsdiss  * fthk)         !! diatom silicon dissolution
+                  trc2d(ji,jj,11) = trc2d(ji,jj,11) + (fgmipn  * fthk)         !! microzoo grazing on non-diatoms
+                  trc2d(ji,jj,12) = trc2d(ji,jj,12) + (fgmid   * fthk)         !! microzoo grazing on detrital nitrogen
+                  trc2d(ji,jj,13) = trc2d(ji,jj,13) + (fdzmi   * fthk)         !! microzoo non-grazing losses
+                  trc2d(ji,jj,14) = trc2d(ji,jj,14) + (fgmepn  * fthk)         !! mesozoo  grazing on non-diatoms
+                  trc2d(ji,jj,15) = trc2d(ji,jj,15) + (fgmepd  * fthk)         !! mesozoo  grazing on diatoms
+                  trc2d(ji,jj,16) = trc2d(ji,jj,16) + (fgmezmi * fthk)         !! mesozoo  grazing on microzoo
+                  trc2d(ji,jj,17) = trc2d(ji,jj,17) + (fgmed   * fthk)         !! mesozoo  grazing on detrital nitrogen
+                  trc2d(ji,jj,18) = trc2d(ji,jj,18) + (fdzme   * fthk)         !! mesozoo  non-grazing losses
+                  !! diagnostic field 19 is (ostensibly) supplied by trcexp.F
+                  trc2d(ji,jj,20) = trc2d(ji,jj,20) + (fslown  * fthk)         !! slow sinking detritus N production
+                  trc2d(ji,jj,21) = trc2d(ji,jj,21) + (fdd     * fthk)         !! detrital remineralisation
+                  trc2d(ji,jj,22) = trc2d(ji,jj,22) + (ffetop  * fthk)         !! aeolian  iron addition
+                  trc2d(ji,jj,23) = trc2d(ji,jj,23) + (ffebot  * fthk)         !! seafloor iron addition
+                  trc2d(ji,jj,24) = trc2d(ji,jj,24) + (ffescav * fthk)         !! "free" iron scavenging
+                  trc2d(ji,jj,25) = trc2d(ji,jj,25) + (fjlim_pn * zphn * fthk) !! non-diatom J  limitation term 
+                  trc2d(ji,jj,26) = trc2d(ji,jj,26) + (fnln  * zphn * fthk)    !! non-diatom N  limitation term 
+                  trc2d(ji,jj,27) = trc2d(ji,jj,27) + (ffln  * zphn * fthk)    !! non-diatom Fe limitation term 
+                  trc2d(ji,jj,28) = trc2d(ji,jj,28) + (fjlim_pd * zphd * fthk) !! diatom     J  limitation term 
+                  trc2d(ji,jj,29) = trc2d(ji,jj,29) + (fnld  * zphd * fthk)    !! diatom     N  limitation term 
+                  trc2d(ji,jj,30) = trc2d(ji,jj,30) + (ffld  * zphd * fthk)    !! diatom     Fe limitation term 
+                  trc2d(ji,jj,31) = trc2d(ji,jj,31) + (fsld2 * zphd * fthk)    !! diatom     Si limitation term 
+                  trc2d(ji,jj,32) = trc2d(ji,jj,32) + (fsld  * zphd * fthk)    !! diatom     Si uptake limitation term
+                  if (jk.eq.i0100) trc2d(ji,jj,33) = fslownflux(ji,jj)         !! slow detritus flux at  100 m
+                  if (jk.eq.i0200) trc2d(ji,jj,34) = fslownflux(ji,jj)         !! slow detritus flux at  200 m
+                  if (jk.eq.i0500) trc2d(ji,jj,35) = fslownflux(ji,jj)         !! slow detritus flux at  500 m
+                  if (jk.eq.i1000) trc2d(ji,jj,36) = fslownflux(ji,jj)         !! slow detritus flux at 1000 m
+                  trc2d(ji,jj,37) = trc2d(ji,jj,37) + fregen                   !! non-fast N  full column regeneration
+                  trc2d(ji,jj,38) = trc2d(ji,jj,38) + fregensi                 !! non-fast Si full column regeneration
+                  if (jk.eq.i0100) trc2d(ji,jj,39) = trc2d(ji,jj,37)           !! non-fast N  regeneration to  100 m
+                  if (jk.eq.i0200) trc2d(ji,jj,40) = trc2d(ji,jj,37)           !! non-fast N  regeneration to  200 m
+                  if (jk.eq.i0500) trc2d(ji,jj,41) = trc2d(ji,jj,37)           !! non-fast N  regeneration to  500 m
+                  if (jk.eq.i1000) trc2d(ji,jj,42) = trc2d(ji,jj,37)           !! non-fast N  regeneration to 1000 m
+                  trc2d(ji,jj,43) = trc2d(ji,jj,43) + (ftempn  * fthk)         !! fast sinking detritus N production
+                  trc2d(ji,jj,44) = trc2d(ji,jj,44) + (ftempsi * fthk)         !! fast sinking detritus Si production
+                  trc2d(ji,jj,45) = trc2d(ji,jj,45) + (ftempfe * fthk)         !! fast sinking detritus Fe production
+                  trc2d(ji,jj,46) = trc2d(ji,jj,46) + (ftempc  * fthk)         !! fast sinking detritus C production
+                  trc2d(ji,jj,47) = trc2d(ji,jj,47) + (ftempca * fthk)         !! fast sinking detritus CaCO3 production
+                  if (jk.eq.i0100) trc2d(ji,jj,48) = ffastn(ji,jj)             !! fast detritus N  flux at  100 m
+                  if (jk.eq.i0200) trc2d(ji,jj,49) = ffastn(ji,jj)             !! fast detritus N  flux at  200 m
+                  if (jk.eq.i0500) trc2d(ji,jj,50) = ffastn(ji,jj)             !! fast detritus N  flux at  500 m
+                  if (jk.eq.i1000) trc2d(ji,jj,51) = ffastn(ji,jj)             !! fast detritus N  flux at 1000 m
+                  if (jk.eq.i0100) trc2d(ji,jj,52) = fregenfast(ji,jj)         !! N  regeneration to  100 m
+                  if (jk.eq.i0200) trc2d(ji,jj,53) = fregenfast(ji,jj)         !! N  regeneration to  200 m
+                  if (jk.eq.i0500) trc2d(ji,jj,54) = fregenfast(ji,jj)         !! N  regeneration to  500 m
+                  if (jk.eq.i1000) trc2d(ji,jj,55) = fregenfast(ji,jj)         !! N  regeneration to 1000 m
+                  if (jk.eq.i0100) trc2d(ji,jj,56) = ffastsi(ji,jj)            !! fast detritus Si flux at  100 m
+                  if (jk.eq.i0200) trc2d(ji,jj,57) = ffastsi(ji,jj)            !! fast detritus Si flux at  200 m
+                  if (jk.eq.i0500) trc2d(ji,jj,58) = ffastsi(ji,jj)            !! fast detritus Si flux at  500 m
+                  if (jk.eq.i1000) trc2d(ji,jj,59) = ffastsi(ji,jj)            !! fast detritus Si flux at 1000 m
+                  if (jk.eq.i0100) trc2d(ji,jj,60) = fregenfastsi(ji,jj)       !! Si regeneration to  100 m
+                  if (jk.eq.i0200) trc2d(ji,jj,61) = fregenfastsi(ji,jj)       !! Si regeneration to  200 m
+                  if (jk.eq.i0500) trc2d(ji,jj,62) = fregenfastsi(ji,jj)       !! Si regeneration to  500 m
+                  if (jk.eq.i1000) trc2d(ji,jj,63) = fregenfastsi(ji,jj)       !! Si regeneration to 1000 m
+                  trc2d(ji,jj,64) = trc2d(ji,jj,64) + (freminn  * fthk)        !! sum of fast-sinking N  fluxes
+                  trc2d(ji,jj,65) = trc2d(ji,jj,65) + (freminsi * fthk)        !! sum of fast-sinking Si fluxes
+                  trc2d(ji,jj,66) = trc2d(ji,jj,66) + (freminfe * fthk)        !! sum of fast-sinking Fe fluxes
+                  trc2d(ji,jj,67) = trc2d(ji,jj,67) + (freminc  * fthk)        !! sum of fast-sinking C  fluxes
+                  trc2d(ji,jj,68) = trc2d(ji,jj,68) + (freminca * fthk)        !! sum of fast-sinking Ca fluxes
+                  if (jk.eq.jmbathy) then
+                     trc2d(ji,jj,69) = fsedn(ji,jj)                                   !! N  sedimentation flux                                  
+                     trc2d(ji,jj,70) = fsedsi(ji,jj)                                  !! Si sedimentation flux
+                     trc2d(ji,jj,71) = fsedfe(ji,jj)                                  !! Fe sedimentation flux
+                     trc2d(ji,jj,72) = fsedc(ji,jj)                                   !! C  sedimentation flux
+                     trc2d(ji,jj,73) = fsedca(ji,jj)                                  !! Ca sedimentation flux
+                  endif
+                  if (jk.eq.1)  trc2d(ji,jj,74) = qsr(ji,jj)
+                  if (jk.eq.1)  trc2d(ji,jj,75) = xpar(ji,jj,jk)
+                  !! if (jk.eq.1)  trc2d(ji,jj,75) = real(iters)
+                  !! diagnostic fields 76 to 80 calculated below
+                  trc2d(ji,jj,81) = trc2d(ji,jj,81) + fprn_ml(ji,jj)           !! mixed layer non-diatom production
+                  trc2d(ji,jj,82) = trc2d(ji,jj,82) + fprd_ml(ji,jj)           !! mixed layer     diatom production
+# if defined key_gulf_finland
+                  if (jk.eq.1)  trc2d(ji,jj,83) = real(ibio_switch)            !! Gulf of Finland check
+# else
+                  trc2d(ji,jj,83) = ocal_ccd(ji,jj)                            !! calcite CCD depth
+# endif
+                  trc2d(ji,jj,84) = fccd(ji,jj)                                !! last model level above calcite CCD depth
+                  if (jk.eq.1)     trc2d(ji,jj,85) = xFree(ji,jj)              !! surface "free" iron
+                  if (jk.eq.i0200) trc2d(ji,jj,86) = xFree(ji,jj)              !! "free" iron at  100 m
+                  if (jk.eq.i0200) trc2d(ji,jj,87) = xFree(ji,jj)              !! "free" iron at  200 m
+                  if (jk.eq.i0500) trc2d(ji,jj,88) = xFree(ji,jj)              !! "free" iron at  500 m
+                  if (jk.eq.i1000) trc2d(ji,jj,89) = xFree(ji,jj)              !! "free" iron at 1000 m
+                  !! AXY (27/06/12): extract "euphotic depth"
+                  if (jk.eq.1)     trc2d(ji,jj,90) = xze(ji,jj)
+                  !! 
+# if defined key_roam
+                  !! ROAM provisionally has access to a further 20 2D diagnostics
+                  if (jk .eq. 1) then
+                     trc2d(ji,jj,91)  = trc2d(ji,jj,91)  + f_wind              !! surface wind
+                     trc2d(ji,jj,92)  = trc2d(ji,jj,92)  + f_pco2atm           !! atmospheric pCO2
+                     trc2d(ji,jj,93)  = trc2d(ji,jj,93)  + f_ph                !! ocean pH
+                     trc2d(ji,jj,94)  = trc2d(ji,jj,94)  + f_pco2w             !! ocean pCO2
+                     trc2d(ji,jj,95)  = trc2d(ji,jj,95)  + f_h2co3             !! ocean H2CO3 conc.
+                     trc2d(ji,jj,96)  = trc2d(ji,jj,96)  + f_hco3              !! ocean HCO3 conc.
+                     trc2d(ji,jj,97)  = trc2d(ji,jj,97)  + f_co3               !! ocean CO3 conc.
+                     trc2d(ji,jj,98)  = trc2d(ji,jj,98)  + f_co2flux           !! air-sea CO2 flux
+                     trc2d(ji,jj,99)  = trc2d(ji,jj,99)  + f_omcal(ji,jj)      !! ocean omega calcite 
+                     trc2d(ji,jj,100) = trc2d(ji,jj,100) + f_omarg(ji,jj)      !! ocean omega aragonite
+                     trc2d(ji,jj,101) = trc2d(ji,jj,101) + f_TDIC              !! ocean TDIC
+                     trc2d(ji,jj,102) = trc2d(ji,jj,102) + f_TALK              !! ocean TALK
+                     trc2d(ji,jj,103) = trc2d(ji,jj,103) + f_kw660             !! surface kw660
+                     trc2d(ji,jj,104) = trc2d(ji,jj,104) + f_pp0               !! surface pressure
+                     trc2d(ji,jj,105) = trc2d(ji,jj,105) + f_o2flux            !! air-sea O2 flux
+                     trc2d(ji,jj,106) = trc2d(ji,jj,106) + f_o2sat             !! ocean O2 saturation
+                     trc2d(ji,jj,107) = f2_ccd_cal(ji,jj)                      !! depth calcite CCD
+                     trc2d(ji,jj,108) = f2_ccd_arg(ji,jj)                      !! depth aragonite CCD
+                  endif
+                  if (jk .eq. jmbathy) then
+                     trc2d(ji,jj,109) = f3_omcal(ji,jj,jk)                     !! seafloor omega calcite
+                     trc2d(ji,jj,110) = f3_omarg(ji,jj,jk)                     !! seafloor omega aragonite
+                  endif
+                  !! diagnostic fields 111 to 117 calculated below
+                  if (jk.eq.i0100) trc2d(ji,jj,118) = ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall)  !! rain ratio at  100 m
+                  if (jk.eq.i0500) trc2d(ji,jj,119) = ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall)  !! rain ratio at  500 m
+                  if (jk.eq.i1000) trc2d(ji,jj,120) = ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall)  !! rain ratio at 1000 m
+                  !! AXY (18/01/12): benthic flux diagnostics
+                  if (jk.eq.jmbathy) then
+                     trc2d(ji,jj,121) = f_sbenin_n(ji,jj)  + f_fbenin_n(ji,jj)
+                     trc2d(ji,jj,122) = f_sbenin_fe(ji,jj) + f_fbenin_fe(ji,jj)
+                     trc2d(ji,jj,123) = f_sbenin_c(ji,jj)  + f_fbenin_c(ji,jj)
+                     trc2d(ji,jj,124) = f_fbenin_si(ji,jj)
+                     trc2d(ji,jj,125) = f_fbenin_ca(ji,jj)
+                     trc2d(ji,jj,126) = f_benout_n(ji,jj)
+                     trc2d(ji,jj,127) = f_benout_fe(ji,jj)
+                     trc2d(ji,jj,128) = f_benout_c(ji,jj)
+                     trc2d(ji,jj,129) = f_benout_si(ji,jj)
+                     trc2d(ji,jj,130) = f_benout_ca(ji,jj)
+                  endif
+                  !! diagnostics fields 131 to 135 calculated below
+                  trc2d(ji,jj,136) = f_runoff(ji,jj)
+                  !! AXY (19/07/12): amended to allow for riverine nutrient addition below surface
+                  trc2d(ji,jj,137) = trc2d(ji,jj,137) + (f_riv_loc_n * fthk)
+                  trc2d(ji,jj,138) = trc2d(ji,jj,138) + (f_riv_loc_si * fthk)
+                  trc2d(ji,jj,139) = trc2d(ji,jj,139) + (f_riv_loc_c * fthk)
+                  trc2d(ji,jj,140) = trc2d(ji,jj,140) + (f_riv_loc_alk * fthk)
+                  trc2d(ji,jj,141) = trc2d(ji,jj,141) + (fslowc  * fthk)       !! slow sinking detritus C production
+                  if (jk.eq.i0100) trc2d(ji,jj,142) = fslowcflux(ji,jj)        !! slow detritus flux at  100 m
+                  if (jk.eq.i0200) trc2d(ji,jj,143) = fslowcflux(ji,jj)        !! slow detritus flux at  200 m
+                  if (jk.eq.i0500) trc2d(ji,jj,144) = fslowcflux(ji,jj)        !! slow detritus flux at  500 m
+                  if (jk.eq.i1000) trc2d(ji,jj,145) = fslowcflux(ji,jj)        !! slow detritus flux at 1000 m
+                  trc2d(ji,jj,146)  = trc2d(ji,jj,146)  + ftot_c(ji,jj)        !! carbon     inventory
+                  trc2d(ji,jj,147)  = trc2d(ji,jj,147)  + ftot_a(ji,jj)        !! alkalinity inventory
+                  trc2d(ji,jj,148)  = trc2d(ji,jj,148)  + ftot_o2(ji,jj)       !! oxygen     inventory
+                  if (jk.eq.jmbathy) then
+                     trc2d(ji,jj,149) = f_benout_lyso_ca(ji,jj)
+                  endif
+                  trc2d(ji,jj,150) = fcomm_resp(ji,jj) * fthk                  !! community respiration
+		  !!
+		  !! AXY (14/02/14): a Valentines Day gift to BASIN - a shedload of new
+                  !!                 diagnostics that they'll most likely never need!
+                  !!                 (actually, as with all such gifts, I'm giving them
+                  !!                 some things I'd like myself!)
+                  !! 
+                  !! ----------------------------------------------------------------------
+                  !! linear losses
+                  !! non-diatom
+                  trc2d(ji,jj,151) = trc2d(ji,jj,151) + (fdpn2  * fthk)
+                  !! diatom
+                  trc2d(ji,jj,152) = trc2d(ji,jj,152) + (fdpd2  * fthk)
+                  !! microzooplankton
+                  trc2d(ji,jj,153) = trc2d(ji,jj,153) + (fdzmi2 * fthk)
+                  !! mesozooplankton
+                  trc2d(ji,jj,154) = trc2d(ji,jj,154) + (fdzme2 * fthk)
+                  !! ----------------------------------------------------------------------
+                  !! microzooplankton grazing
+                  !! microzooplankton messy -> N
+                  trc2d(ji,jj,155) = trc2d(ji,jj,155) + (xphi * (fgmipn + fgmid) * fthk)
+                  !! microzooplankton messy -> D
+                  trc2d(ji,jj,156) = trc2d(ji,jj,156) + ((1. - xbetan) * finmi * fthk)
+                  !! microzooplankton messy -> DIC
+                  trc2d(ji,jj,157) = trc2d(ji,jj,157) + (xphi * ((xthetapn * fgmipn) + fgmidc) * fthk)
+                  !! microzooplankton messy -> Dc
+                  trc2d(ji,jj,158) = trc2d(ji,jj,158) + ((1. - xbetac) * ficmi * fthk)
+                  !! microzooplankton excretion
+                  trc2d(ji,jj,159) = trc2d(ji,jj,159) + (fmiexcr * fthk)
+                  !! microzooplankton respiration
+                  trc2d(ji,jj,160) = trc2d(ji,jj,160) + (fmiresp * fthk)
+                  !! microzooplankton growth
+                  trc2d(ji,jj,161) = trc2d(ji,jj,161) + (fmigrow * fthk)
+                  !! ----------------------------------------------------------------------
+                  !! mesozooplankton grazing
+                  !! mesozooplankton messy -> N
+                  trc2d(ji,jj,162) = trc2d(ji,jj,162) + (xphi * (fgmepn + fgmepd + fgmezmi + fgmed) * fthk)
+                  !! mesozooplankton messy -> D
+                  trc2d(ji,jj,163) = trc2d(ji,jj,163) + ((1. - xbetan) * finme * fthk)
+                  !! mesozooplankton messy -> DIC
+                  trc2d(ji,jj,164) = trc2d(ji,jj,164) + (xphi * ((xthetapn * fgmepn) + (xthetapd * fgmepd) + &
+                  &                  (xthetazmi * fgmezmi) + fgmedc) * fthk)
+                  !! mesozooplankton messy -> Dc
+                  trc2d(ji,jj,165) = trc2d(ji,jj,165) + ((1. - xbetac) * ficme * fthk)
+                  !! mesozooplankton excretion
+                  trc2d(ji,jj,166) = trc2d(ji,jj,166) + (fmeexcr * fthk)
+                  !! mesozooplankton respiration
+                  trc2d(ji,jj,167) = trc2d(ji,jj,167) + (fmeresp * fthk)
+                  !! mesozooplankton growth
+                  trc2d(ji,jj,168) = trc2d(ji,jj,168) + (fmegrow * fthk)
+                  !! ----------------------------------------------------------------------
+                  !! miscellaneous
+                  trc2d(ji,jj,169) = trc2d(ji,jj,169) + (fddc    * fthk) !! detrital C remineralisation
+                  trc2d(ji,jj,170) = trc2d(ji,jj,170) + (fgmidc  * fthk) !! microzoo grazing on detrital carbon
+                  trc2d(ji,jj,171) = trc2d(ji,jj,171) + (fgmedc  * fthk) !! mesozoo  grazing on detrital carbon
+                  !!
+                  !! ----------------------------------------------------------------------
+		  !!
+		  !! AXY (23/10/14): extract primary production related surface fields to
+		  !!                 deal with diel cycle issues; hijacking BASIN 150m
+		  !!                 diagnostics to do so (see commented out diagnostics
+		  !!                 below this section)
+		  !!
+		  !! extract fields at surface
+		 !! if (jk .eq. 1) then
+                 !!    trc2d(ji,jj,172) = zchn              !! Pn chlorophyll
+                 !!    trc2d(ji,jj,173) = zphn              !! Pn biomass
+                 !!    trc2d(ji,jj,174) = fjln              !! Pn J-term
+                 !!    trc2d(ji,jj,175) = (fprn * zphn)     !! Pn PP
+                 !!    trc2d(ji,jj,176) = zchd              !! Pd chlorophyll
+                 !!    trc2d(ji,jj,177) = zphd              !! Pd biomass
+                 !!    trc2d(ji,jj,178) = fjld              !! Pd J-term
+                 !!    trc2d(ji,jj,179) = xpar(ji,jj,jk)    !! Pd PP
+                 !!    trc2d(ji,jj,180) = loc_T             !! local temperature
+                 !! endif
+		 !! !!
+		 !! !! extract fields at 50m (actually 44-50m)
+		 !! if (jk .eq. 18) then
+                 !!    trc2d(ji,jj,181) = zchn              !! Pn chlorophyll
+                 !!    trc2d(ji,jj,182) = zphn              !! Pn biomass
+                 !!    trc2d(ji,jj,183) = fjln              !! Pn J-term
+                 !!    trc2d(ji,jj,184) = (fprn * zphn)     !! Pn PP
+                 !!    trc2d(ji,jj,185) = zchd              !! Pd chlorophyll
+                 !!    trc2d(ji,jj,186) = zphd              !! Pd biomass
+                 !!    trc2d(ji,jj,187) = fjld              !! Pd J-term
+                 !!    trc2d(ji,jj,188) = xpar(ji,jj,jk)    !! Pd PP
+                 !!    trc2d(ji,jj,189) = loc_T             !! local temperature
+                 !! endif
+		 !! !!
+		 !! !! extract fields at 100m
+		 !! if (jk .eq. i0100) then
+                 !!    trc2d(ji,jj,190) = zchn              !! Pn chlorophyll
+                 !!    trc2d(ji,jj,191) = zphn              !! Pn biomass
+                 !!    trc2d(ji,jj,192) = fjln              !! Pn J-term
+                 !!    trc2d(ji,jj,193) = (fprn * zphn)     !! Pn PP
+                 !!    trc2d(ji,jj,194) = zchd              !! Pd chlorophyll
+                 !!    trc2d(ji,jj,195) = zphd              !! Pd biomass
+                 !!    trc2d(ji,jj,196) = fjld              !! Pd J-term
+                 !!    trc2d(ji,jj,197) = xpar(ji,jj,jk)    !! Pd PP
+                 !!    trc2d(ji,jj,198) = loc_T             !! local temperature
+                 !! endif
+                 !!
+                  !! extract relevant BASIN fields at 150m
+                  if (jk .eq. i0150) then
+                     trc2d(ji,jj,172) = trc2d(ji,jj,4)    !! Pn PP
+                     trc2d(ji,jj,173) = trc2d(ji,jj,151)  !! Pn linear loss
+                     trc2d(ji,jj,174) = trc2d(ji,jj,5)    !! Pn non-linear loss
+                     trc2d(ji,jj,175) = trc2d(ji,jj,11)   !! Pn grazing to Zmi
+                     trc2d(ji,jj,176) = trc2d(ji,jj,14)   !! Pn grazing to Zme
+                     trc2d(ji,jj,177) = trc2d(ji,jj,6)    !! Pd PP
+                     trc2d(ji,jj,178) = trc2d(ji,jj,152)  !! Pd linear loss
+                     trc2d(ji,jj,179) = trc2d(ji,jj,7)    !! Pd non-linear loss
+                     trc2d(ji,jj,180) = trc2d(ji,jj,15)   !! Pd grazing to Zme
+                     trc2d(ji,jj,181) = trc2d(ji,jj,12)   !! Zmi grazing on D
+                     trc2d(ji,jj,182) = trc2d(ji,jj,170)  !! Zmi grazing on Dc
+                     trc2d(ji,jj,183) = trc2d(ji,jj,155)  !! Zmi messy feeding loss to N
+                     trc2d(ji,jj,184) = trc2d(ji,jj,156)  !! Zmi messy feeding loss to D
+                     trc2d(ji,jj,185) = trc2d(ji,jj,157)  !! Zmi messy feeding loss to DIC
+                     trc2d(ji,jj,186) = trc2d(ji,jj,158)  !! Zmi messy feeding loss to Dc
+                     trc2d(ji,jj,187) = trc2d(ji,jj,159)  !! Zmi excretion
+                     trc2d(ji,jj,188) = trc2d(ji,jj,160)  !! Zmi respiration
+                     trc2d(ji,jj,189) = trc2d(ji,jj,161)  !! Zmi growth
+                     trc2d(ji,jj,190) = trc2d(ji,jj,153)  !! Zmi linear loss
+                     trc2d(ji,jj,191) = trc2d(ji,jj,13)   !! Zmi non-linear loss
+                     trc2d(ji,jj,192) = trc2d(ji,jj,16)   !! Zmi grazing to Zme
+                     trc2d(ji,jj,193) = trc2d(ji,jj,17)   !! Zme grazing on D
+                     trc2d(ji,jj,194) = trc2d(ji,jj,171)  !! Zme grazing on Dc
+                     trc2d(ji,jj,195) = trc2d(ji,jj,162)  !! Zme messy feeding loss to N
+                     trc2d(ji,jj,196) = trc2d(ji,jj,163)  !! Zme messy feeding loss to D
+                     trc2d(ji,jj,197) = trc2d(ji,jj,164)  !! Zme messy feeding loss to DIC
+                     trc2d(ji,jj,198) = trc2d(ji,jj,165)  !! Zme messy feeding loss to Dc
+                     trc2d(ji,jj,199) = trc2d(ji,jj,166)  !! Zme excretion
+                     trc2d(ji,jj,200) = trc2d(ji,jj,167)  !! Zme respiration
+                     trc2d(ji,jj,201) = trc2d(ji,jj,168)  !! Zme growth
+                     trc2d(ji,jj,202) = trc2d(ji,jj,154)  !! Zme linear loss
+                     trc2d(ji,jj,203) = trc2d(ji,jj,18)   !! Zme non-linear loss
+                     trc2d(ji,jj,204) = trc2d(ji,jj,20)   !! Slow detritus production, N
+                     trc2d(ji,jj,205) = trc2d(ji,jj,21)   !! Slow detritus remineralisation, N
+                     trc2d(ji,jj,206) = trc2d(ji,jj,141)  !! Slow detritus production, C
+                     trc2d(ji,jj,207) = trc2d(ji,jj,169)  !! Slow detritus remineralisation, C
+                     trc2d(ji,jj,208) = trc2d(ji,jj,43)   !! Fast detritus production, N
+                     trc2d(ji,jj,209) = trc2d(ji,jj,21)   !! Fast detritus remineralisation, N
+                     trc2d(ji,jj,210) = trc2d(ji,jj,64)   !! Fast detritus production, C
+                     trc2d(ji,jj,211) = trc2d(ji,jj,67)   !! Fast detritus remineralisation, C
+                     trc2d(ji,jj,212) = trc2d(ji,jj,150)  !! Community respiration
+                     trc2d(ji,jj,213) = fslownflux(ji,jj) !! Slow detritus N flux at 150 m
+                     trc2d(ji,jj,214) = fslowcflux(ji,jj) !! Slow detritus C flux at 150 m
+                     trc2d(ji,jj,215) = ffastn(ji,jj)     !! Fast detritus N flux at 150 m
+                     trc2d(ji,jj,216) = ffastc(ji,jj)     !! Fast detritus C flux at 150 m
+                  endif
+                  !! 
+                  !! Jpalm (11-08-2014)
+                  !! Add UKESM1 diagnoatics 
+                  !!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+                  if ((jk .eq. 1) .and.( jdms.eq.1)) then
+                     trc2d(ji,jj,221) = dms_surf          !! DMS surface concentration 
+                     !! AXY (13/03/15): add in other DMS estimates
+                     trc2d(ji,jj,222) = dms_andr          !! DMS surface concentration 
+                     trc2d(ji,jj,223) = dms_simo          !! DMS surface concentration 
+                     trc2d(ji,jj,224) = dms_aran          !! DMS surface concentration 
+                     trc2d(ji,jj,225) = dms_hall          !! DMS surface concentration 
+                  endif
+# endif
+                  !! other possible future diagnostics include:
+                  !!   - integrated tracer values (esp. biological)
+                  !!   - mixed layer tracer values
+                  !!   - sub-surface chlorophyll maxima (plus depth)
+                  !!   - different mixed layer depth criteria (T, sigma, var. sigma)
+
+                  !!----------------------------------------------------------------------
+                  !! Prepare 3D diagnostics
+                  !!----------------------------------------------------------------------
+                  !!
+                  trc3d(ji,jj,jk,1)  = ((fprn + fprd) * zphn)     !! primary production  
+                  trc3d(ji,jj,jk,2)  = fslownflux(ji,jj) + ffastn(ji,jj) !! detrital flux
+                  trc3d(ji,jj,jk,3)  = fregen + (freminn * fthk)  !! remineralisation
+# if defined key_roam
+                  trc3d(ji,jj,jk,4)  = f3_pH(ji,jj,jk)            !! pH
+                  trc3d(ji,jj,jk,5)  = f3_omcal(ji,jj,jk)         !! omega calcite
+# else
+                  trc3d(ji,jj,jk,4)  = ffastsi(ji,jj)             !! fast Si flux
+# endif
+             ENDIF   ! end of ln_diatrc option
+             !! CLOSE wet point IF..THEN loop
+            endif
+         !! CLOSE horizontal loops
+         ENDDO
+         ENDDO
+         !!
+             IF( lk_iomput  .AND.  .NOT.  ln_diatrc  ) THEN
+                 !! first - 2D diag implemented 
+                 !!         on every K level
+                 !!-----------------------------------------
+                 !!  --
+                 !!second - 2d specific k level diags
+                 !!
+                 !!-----------------------------------------
+                 IF (jk.eq.1) THEN
+#   if defined key_debug_medusa
+                     IF (lwp) write (numout,*) 'trc_bio_medusa: diag jk = 1'
+                     CALL flush(numout)
+#   endif            
+                     !! JPALM -- 02-06-2017 --
+                     !! add Chl surf coupling
+                     !! no need to output, just pass to cpl var
+                     IF (lk_oasis) THEN
+                          zn_chl_srf(:,:) = (trn(:,:,1,jpchd) + trn(:,:,1,jpchn)) * 1.0E-6  !! surf Chl in Kg-chl/m3 as needed for cpl
+                         chloro_out_cpl(:,:) = zn_chl_srf(:,:)        !! Coupling Chl
+                     END IF
+                     IF( med_diag%MED_QSR%dgsave ) THEN
+                         CALL iom_put( "MED_QSR"  , qsr ) !
+                     ENDIF
+                     IF( med_diag%MED_XPAR%dgsave ) THEN
+                         CALL iom_put( "MED_XPAR"  , xpar(:,:,jk) ) !
+                     ENDIF       
+                     IF( med_diag%OCAL_CCD%dgsave ) THEN
+                         CALL iom_put( "OCAL_CCD"  , ocal_ccd ) !
+                     ENDIF
+                     IF( med_diag%FE_0000%dgsave ) THEN
+                         CALL iom_put( "FE_0000"  , xFree ) !
+                     ENDIF                     
+                     IF( med_diag%MED_XZE%dgsave ) THEN
+                         CALL iom_put( "MED_XZE"  , xze ) !
+                     ENDIF 
+# if defined key_roam                     
+                     IF( med_diag%WIND%dgsave ) THEN
+                         CALL iom_put( "WIND"  , wndm )
+                     ENDIF
+                     IF( med_diag%ATM_PCO2%dgsave ) THEN
+                         CALL iom_put( "ATM_PCO2"  , f_pco2a2d )
+                         CALL wrk_dealloc( jpi, jpj,    f_pco2a2d  )
+                     ENDIF
+                     IF( med_diag%OCN_PH%dgsave ) THEN
+                         zw2d(:,:) = f3_pH(:,:,jk)
+                         CALL iom_put( "OCN_PH"  , zw2d )
+                     ENDIF
+                     IF( med_diag%OCN_PCO2%dgsave ) THEN
+                        CALL iom_put( "OCN_PCO2"  , f_pco2w2d )
+                        CALL wrk_dealloc( jpi, jpj,   f_pco2w2d   )
+                     ENDIF
+                     IF( med_diag%OCNH2CO3%dgsave ) THEN
+                         zw2d(:,:) = f3_h2co3(:,:,jk)
+                         CALL iom_put( "OCNH2CO3"  , zw2d )
+                     ENDIF
+                     IF( med_diag%OCN_HCO3%dgsave ) THEN
+                         zw2d(:,:) = f3_hco3(:,:,jk)
+                         CALL iom_put( "OCN_HCO3"  , zw2d )
+                     ENDIF
+                     IF( med_diag%OCN_CO3%dgsave ) THEN
+                         zw2d(:,:) = f3_co3(:,:,jk)
+                         CALL iom_put( "OCN_CO3"  , zw2d )
+                     ENDIF
+                     IF( med_diag%CO2FLUX%dgsave ) THEN
+                        CALL iom_put( "CO2FLUX"  , f_co2flux2d )
+                        CALL wrk_dealloc( jpi, jpj,   f_co2flux2d   )
+                     ENDIF
+                     !! 
+                     !! AXY (10/11/16): repeat CO2 flux diagnostic in UKMO/CMIP6 units; this
+                     !!                 both outputs the CO2 flux in specified units and
+                     !!                 sends the resulting field to the coupler
+                     !! JPALM (17/11/16): put CO2 flux (fgco2) alloc/unalloc/pass to zn 
+                     !!                 out of diag list request 
+                     CALL lbc_lnk( fgco2(:,:),'T',1. )
+                     IF( med_diag%FGCO2%dgsave ) THEN
+                         CALL iom_put( "FGCO2"  , fgco2 )
+                     ENDIF
+                     !! JPALM (17/11/16): should mv this fgco2 part 
+                     !!                   out of lk_iomput loop
+                     zb_co2_flx = zn_co2_flx
+                     zn_co2_flx = fgco2
+                     IF (lk_oasis) THEN
+                        CO2Flux_out_cpl = zn_co2_flx
+                     ENDIF
+                     CALL wrk_dealloc( jpi, jpj,   fgco2   )
+                     !! ---
+                     IF( med_diag%OM_CAL%dgsave ) THEN
+                         CALL iom_put( "OM_CAL"  , f_omcal )
+                     ENDIF
+                     IF( med_diag%OM_ARG%dgsave ) THEN
+                         CALL iom_put( "OM_ARG"  , f_omarg )
+                     ENDIF
+                     IF( med_diag%TCO2%dgsave ) THEN
+                         CALL iom_put( "TCO2"  , f_TDIC2d )
+                         CALL wrk_dealloc( jpi, jpj,   f_TDIC2d   )
+                     ENDIF
+                     IF( med_diag%TALK%dgsave ) THEN
+                         CALL iom_put( "TALK"  , f_TALK2d )
+                         CALL wrk_dealloc( jpi, jpj,    f_TALK2d  )
+                     ENDIF
+                     IF( med_diag%KW660%dgsave ) THEN
+                         CALL iom_put( "KW660"  , f_kw6602d )
+                         CALL wrk_dealloc( jpi, jpj,   f_kw6602d   )
+                     ENDIF
+                     IF( med_diag%ATM_PP0%dgsave ) THEN
+                         CALL iom_put( "ATM_PP0"  , f_pp02d )
+                         CALL wrk_dealloc( jpi, jpj,    f_pp02d  )
+                     ENDIF
+                     IF( med_diag%O2FLUX%dgsave ) THEN
+                         CALL iom_put( "O2FLUX"  , f_o2flux2d )
+                         CALL wrk_dealloc( jpi, jpj,   f_o2flux2d   )
+                     ENDIF
+                     IF( med_diag%O2SAT%dgsave ) THEN
+                         CALL iom_put( "O2SAT"  , f_o2sat2d )
+                         CALL wrk_dealloc( jpi, jpj,  f_o2sat2d    )
+                     ENDIF
+                     IF( med_diag%CAL_CCD%dgsave ) THEN
+                         CALL iom_put( "CAL_CCD"  , f2_ccd_cal )
+                     ENDIF
+                     IF( med_diag%ARG_CCD%dgsave ) THEN
+                         CALL iom_put( "ARG_CCD"  , f2_ccd_arg )
+                     ENDIF
+                     IF (jdms .eq. 1) THEN
+                       IF( med_diag%DMS_SURF%dgsave ) THEN
+                         CALL lbc_lnk(dms_surf2d(:,:),'T',1. )
+                         CALL iom_put( "DMS_SURF"  , dms_surf2d )
+                         zb_dms_srf = zn_dms_srf
+                         zn_dms_srf = dms_surf2d
+                         IF (lk_oasis) THEN
+                            DMS_out_cpl = zn_dms_srf
+                         ENDIF
+                         CALL wrk_dealloc( jpi, jpj,   dms_surf2d   ) 
+                       ENDIF
+                       IF( med_diag%DMS_ANDR%dgsave ) THEN
+                         CALL iom_put( "DMS_ANDR"  , dms_andr2d )
+                         CALL wrk_dealloc( jpi, jpj,   dms_andr2d   )
+                       ENDIF
+                       IF( med_diag%DMS_SIMO%dgsave ) THEN
+                         CALL iom_put( "DMS_SIMO"  , dms_simo2d )
+                         CALL wrk_dealloc( jpi, jpj,    dms_simo2d  )
+                       ENDIF
+                       IF( med_diag%DMS_ARAN%dgsave ) THEN
+                         CALL iom_put( "DMS_ARAN"  , dms_aran2d )
+                         CALL wrk_dealloc( jpi, jpj,   dms_aran2d   )
+                       ENDIF
+                       IF( med_diag%DMS_HALL%dgsave ) THEN
+                         CALL iom_put( "DMS_HALL"  , dms_hall2d )
+                         CALL wrk_dealloc( jpi, jpj,   dms_hall2d   )
+                       ENDIF
+                       IF( med_diag%DMS_ANDM%dgsave ) THEN
+                         CALL iom_put( "DMS_ANDM"  , dms_andm2d )
+                         CALL wrk_dealloc( jpi, jpj,   dms_andm2d   )
+                       ENDIF
+                     ENDIF
+                     !! AXY (24/11/16): extra MOCSY diagnostics
+                     IF( med_diag%ATM_XCO2%dgsave ) THEN
+                        CALL iom_put( "ATM_XCO2"  ,   f_xco2a_2d      )
+                        CALL wrk_dealloc( jpi, jpj,   f_xco2a_2d      )
+                     ENDIF
+                     IF( med_diag%OCN_FCO2%dgsave ) THEN
+                        CALL iom_put( "OCN_FCO2"  ,   f_fco2w_2d      )
+                        CALL wrk_dealloc( jpi, jpj,   f_fco2w_2d      )
+                     ENDIF
+                     IF( med_diag%ATM_FCO2%dgsave ) THEN
+                        CALL iom_put( "ATM_FCO2"  ,   f_fco2a_2d      )
+                        CALL wrk_dealloc( jpi, jpj,   f_fco2a_2d      )
+                     ENDIF
+                     IF( med_diag%OCN_RHOSW%dgsave ) THEN
+                        CALL iom_put( "OCN_RHOSW"  ,  f_ocnrhosw_2d   )
+                        CALL wrk_dealloc( jpi, jpj,   f_ocnrhosw_2d   )
+                     ENDIF
+                     IF( med_diag%OCN_SCHCO2%dgsave ) THEN
+                        CALL iom_put( "OCN_SCHCO2"  , f_ocnschco2_2d  )
+                        CALL wrk_dealloc( jpi, jpj,   f_ocnschco2_2d  )
+                     ENDIF
+                     IF( med_diag%OCN_KWCO2%dgsave ) THEN
+                        CALL iom_put( "OCN_KWCO2"  ,  f_ocnkwco2_2d   )
+                        CALL wrk_dealloc( jpi, jpj,   f_ocnkwco2_2d   )
+                     ENDIF
+                     IF( med_diag%OCN_K0%dgsave ) THEN
+                        CALL iom_put( "OCN_K0"  ,     f_ocnk0_2d      )
+                        CALL wrk_dealloc( jpi, jpj,   f_ocnk0_2d      )
+                     ENDIF
+                     IF( med_diag%CO2STARAIR%dgsave ) THEN
+                        CALL iom_put( "CO2STARAIR"  , f_co2starair_2d )
+                        CALL wrk_dealloc( jpi, jpj,   f_co2starair_2d )
+                     ENDIF
+                     IF( med_diag%OCN_DPCO2%dgsave ) THEN
+                        CALL iom_put( "OCN_DPCO2"  ,  f_ocndpco2_2d   )
+                        CALL wrk_dealloc( jpi, jpj,   f_ocndpco2_2d   )
+                     ENDIF
+# endif                     
+                 ELSE IF (jk.eq.i0100) THEN 
+#   if defined key_debug_medusa
+                     IF (lwp) write (numout,*) 'trc_bio_medusa: diag jk = 100'
+                     CALL flush(numout)
+#   endif
+                     IF( med_diag%SDT__100%dgsave ) THEN
+                        zw2d(:,:) = fslownflux(:,:) * tmask(:,:,jk)
+                        CALL iom_put( "SDT__100"  , zw2d )
+                     ENDIF
+                     IF( med_diag%REG__100%dgsave ) THEN
+                        CALL iom_put( "REG__100"  , fregen2d )
+                     ENDIF
+                     IF( med_diag%FDT__100%dgsave ) THEN
+                        CALL iom_put( "FDT__100"  , ffastn )
+                     ENDIF           
+                     IF( med_diag%RG__100F%dgsave ) THEN
+                        CALL iom_put( "RG__100F"  , fregenfast )
+                     ENDIF
+                     IF( med_diag%FDS__100%dgsave ) THEN
+                        CALL iom_put( "FDS__100"  , ffastsi )
+                     ENDIF         
+                     IF( med_diag%RGS_100F%dgsave ) THEN
+                        CALL iom_put( "RGS_100F"  , fregenfastsi )
+                     ENDIF
+                     IF( med_diag%FE_0100%dgsave ) THEN
+                        CALL iom_put( "FE_0100"  , xFree )
+                     ENDIF
+# if defined key_roam                     
+                     IF( med_diag%RR_0100%dgsave ) THEN
+                        CALL iom_put( "RR_0100"  , ffastca2d )
+                     ENDIF                     
+                     IF( med_diag%SDC__100%dgsave ) THEN
+                        zw2d(:,:) = fslowcflux(:,:) * tmask(:,:,jk)
+                        CALL iom_put( "SDC__100"  , zw2d )
+                     ENDIF                  
+                     IF( med_diag%epC100%dgsave    ) THEN
+                        zw2d(:,:) = (fslowcflux + ffastc) * tmask(:,:,jk)
+                        CALL iom_put( "epC100"    , zw2d )
+                     ENDIF		     
+                     IF( med_diag%epCALC100%dgsave ) THEN
+                        CALL iom_put( "epCALC100" , ffastca )
+                     ENDIF		     
+                     IF( med_diag%epN100%dgsave    ) THEN
+                        zw2d(:,:) = (fslownflux + ffastn) * tmask(:,:,jk)
+                        CALL iom_put( "epN100"    , zw2d )
+                     ENDIF		     
+                     IF( med_diag%epSI100%dgsave   ) THEN
+                        CALL iom_put( "epSI100"   , ffastsi )
+                     ENDIF		     
+                 ELSE IF (jk.eq.i0150) THEN
+#   if defined key_debug_medusa
+                     IF (lwp) write (numout,*) 'trc_bio_medusa: diag jk = 150'
+                     CALL flush(numout)
+#   endif
+# endif                     
+                 ELSE IF (jk.eq.i0200) THEN
+#   if defined key_debug_medusa
+                     IF (lwp) write (numout,*) 'trc_bio_medusa: diag jk = 200'
+                     CALL flush(numout)
+#   endif
+                     IF( med_diag%SDT__200%dgsave ) THEN
+                        zw2d(:,:) = fslownflux(:,:) * tmask(:,:,jk)
+                        CALL iom_put( "SDT__200"  , zw2d )
+                     ENDIF
+                     IF( med_diag%REG__200%dgsave ) THEN
+                        CALL iom_put( "REG__200"  , fregen2d )
+                     ENDIF
+                     IF( med_diag%FDT__200%dgsave ) THEN
+                        CALL iom_put( "FDT__200"  , ffastn )
+                     ENDIF
+                     IF( med_diag%RG__200F%dgsave ) THEN
+                        CALL iom_put( "RG__200F"  , fregenfast )
+                     ENDIF
+                     IF( med_diag%FDS__200%dgsave ) THEN
+                        CALL iom_put( "FDS__200"  , ffastsi )
+                     ENDIF
+                     IF( med_diag%RGS_200F%dgsave ) THEN
+                        CALL iom_put( "RGS_200F"  , fregenfastsi )
+                     ENDIF
+                     IF( med_diag%FE_0200%dgsave ) THEN
+                        CALL iom_put( "FE_0200"   , xFree )
+                     ENDIF
+# if defined key_roam                     
+                     IF( med_diag%SDC__200%dgsave ) THEN
+                        zw2d(:,:) = fslowcflux(:,:) * tmask(:,:,jk)
+                        CALL iom_put( "SDC__200"  , zw2d )
+                     ENDIF
+# endif                     
+                 ELSE IF (jk.eq.i0500) THEN
+#   if defined key_debug_medusa
+                     IF (lwp) write (numout,*) 'trc_bio_medusa: diag jk = 500'
+                     CALL flush(numout)
+#   endif
+                     IF( med_diag%SDT__500%dgsave ) THEN
+                        zw2d(:,:) = fslownflux(:,:) * tmask(:,:,jk)
+                        CALL iom_put( "SDT__500"  , zw2d )
+                     ENDIF
+                     IF( med_diag%REG__500%dgsave ) THEN
+                        CALL iom_put( "REG__500"  , fregen2d )
+                     ENDIF      
+                     IF( med_diag%FDT__500%dgsave ) THEN
+                        CALL iom_put( "FDT__500"  , ffastn )
+                     ENDIF
+                     IF( med_diag%RG__500F%dgsave ) THEN
+                        CALL iom_put( "RG__500F"  , fregenfast )
+                     ENDIF
+                     IF( med_diag%FDS__500%dgsave ) THEN
+                        CALL iom_put( "FDS__500"  , ffastsi )
+                     ENDIF
+                     IF( med_diag%RGS_500F%dgsave ) THEN
+                        CALL iom_put( "RGS_500F"  , fregenfastsi )
+                     ENDIF
+                     IF( med_diag%FE_0500%dgsave ) THEN
+                        CALL iom_put( "FE_0500"  , xFree )
+                     ENDIF
+# if defined key_roam                     
+                     IF( med_diag%RR_0500%dgsave ) THEN
+                        CALL iom_put( "RR_0500"  , ffastca2d )
+                     ENDIF
+                     IF( med_diag%SDC__500%dgsave ) THEN
+                        zw2d(:,:) = fslowcflux(:,:) * tmask(:,:,jk)
+                        CALL iom_put( "SDC__500"  , zw2d )
+                     ENDIF  
+# endif                      
+                 ELSE IF (jk.eq.i1000) THEN
+#   if defined key_debug_medusa
+                     IF (lwp) write (numout,*) 'trc_bio_medusa: diag jk = 1000'
+                     CALL flush(numout)
+#   endif
+                     IF( med_diag%SDT_1000%dgsave ) THEN
+                        zw2d(:,:) = fslownflux(:,:) * tmask(:,:,jk)
+                        CALL iom_put( "SDT_1000"  , zw2d )
+                     ENDIF
+                     IF( med_diag%REG_1000%dgsave ) THEN
+                        CALL iom_put( "REG_1000"  , fregen2d )
+                     ENDIF  
+                     IF( med_diag%FDT_1000%dgsave ) THEN
+                        CALL iom_put( "FDT_1000"  , ffastn )
+                     ENDIF
+                     IF( med_diag%RG_1000F%dgsave ) THEN
+                        CALL iom_put( "RG_1000F"  , fregenfast )
+                     ENDIF
+                     IF( med_diag%FDS_1000%dgsave ) THEN
+                        CALL iom_put( "FDS_1000"  , ffastsi )
+                     ENDIF
+                     IF( med_diag%RGS1000F%dgsave ) THEN
+                        CALL iom_put( "RGS1000F"  , fregenfastsi )
+                     ENDIF
+                     IF( med_diag%FE_1000%dgsave ) THEN
+                        CALL iom_put( "FE_1000"  , xFree )
+                     ENDIF
+# if defined key_roam                     
+                     IF( med_diag%RR_1000%dgsave ) THEN
+                        CALL iom_put( "RR_1000"  , ffastca2d )
+                        CALL wrk_dealloc( jpi, jpj,  ffastca2d    )
+                     ENDIF
+                     IF( med_diag%SDC_1000%dgsave ) THEN
+                        zw2d(:,:) = fslowcflux(:,:) * tmask(:,:,jk)
+                        CALL iom_put( "SDC_1000"  , zw2d )
+                     ENDIF 
+# endif                      
+                 ENDIF
+                 !! to do on every k loop :
+                 IF( med_diag%DETFLUX3%dgsave ) THEN
+                      detflux3d(:,:,jk) = (fslownflux(:,:) + ffastn(:,:)) * tmask(:,:,jk) !! detrital flux
+                      !CALL iom_put( "DETFLUX3"  , ftot_n )
+                 ENDIF
+# if defined key_roam                     
+                 IF( med_diag%EXPC3%dgsave ) THEN
+                    expc3(:,:,jk) = (fslowcflux(:,:) + ffastc(:,:)) * tmask(:,:,jk)
+                 ENDIF		     
+                 IF( med_diag%EXPN3%dgsave ) THEN
+                    expn3(:,:,jk) = (fslownflux(:,:) + ffastn(:,:)) * tmask(:,:,jk)
+                 ENDIF		     
+# endif		     
+              ENDIF
+      !! CLOSE vertical loop
+      ENDDO
+
+      !!----------------------------------------------------------------------
+      !! Process benthic in/out fluxes
+      !! These can be handled outside of the 3D calculations since the
+      !! benthic pools (and fluxes) are 2D in nature; this code is
+      !! (shamelessly) borrowed from corresponding code in the LOBSTER
+      !! model
+      !!----------------------------------------------------------------------
+      !!
+      !! IF(lwp) WRITE(numout,*) 'AXY: rdt = ', rdt
+      if (jorgben.eq.1) then
+         za_sed_n(:,:)  = zn_sed_n(:,:)  + & 
+         &                ( f_sbenin_n(:,:)  + f_fbenin_n(:,:)  - f_benout_n(:,:)  ) * (rdt / 86400.)
+         zn_sed_n(:,:)  = za_sed_n(:,:)
+         !!
+         za_sed_fe(:,:) = zn_sed_fe(:,:) + &
+         &                ( f_sbenin_fe(:,:) + f_fbenin_fe(:,:) - f_benout_fe(:,:) ) * (rdt / 86400.)
+         zn_sed_fe(:,:) = za_sed_fe(:,:)
+         !!
+         za_sed_c(:,:)  = zn_sed_c(:,:)  + &
+         &                ( f_sbenin_c(:,:)  + f_fbenin_c(:,:)  - f_benout_c(:,:)  ) * (rdt / 86400.)
+         zn_sed_c(:,:)  = za_sed_c(:,:)
+      endif
+      if (jinorgben.eq.1) then
+         za_sed_si(:,:) = zn_sed_si(:,:) + & 
+         &                ( f_fbenin_si(:,:) - f_benout_si(:,:) ) * (rdt / 86400.)
+         zn_sed_si(:,:) = za_sed_si(:,:)
+         !!
+         za_sed_ca(:,:) = zn_sed_ca(:,:) + &
+         &                ( f_fbenin_ca(:,:) - f_benout_ca(:,:) ) * (rdt / 86400.)
+         zn_sed_ca(:,:) = za_sed_ca(:,:)
+      endif
+      IF( ln_diatrc ) THEN
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               trc2d(ji,jj,131) = za_sed_n(ji,jj)
+               trc2d(ji,jj,132) = za_sed_fe(ji,jj)
+               trc2d(ji,jj,133) = za_sed_c(ji,jj)
+               trc2d(ji,jj,134) = za_sed_si(ji,jj)
+               trc2d(ji,jj,135) = za_sed_ca(ji,jj)
+            ENDDO
+         ENDDO
+         !! AXY (07/07/15): temporary hijacking
+# if defined key_roam
+  !!       trc2d(:,:,126) = zn_dms_chn(:,:)
+  !!       trc2d(:,:,127) = zn_dms_chd(:,:)
+  !!       trc2d(:,:,128) = zn_dms_mld(:,:)
+  !!       trc2d(:,:,129) = zn_dms_qsr(:,:)
+  !!       trc2d(:,:,130) = zn_dms_din(:,:)
+# endif
+      ENDIF 
+      !!
+      if (ibenthic.eq.2) then
+         !! The code below (in this if ... then ... endif loop) is
+         !! effectively commented out because it does not work as 
+         !! anticipated; it can be deleted at a later date
+         if (jorgben.eq.1) then
+            za_sed_n(:,:)  = ( f_sbenin_n(:,:)  + f_fbenin_n(:,:)  - f_benout_n(:,:)  ) * rdt
+            za_sed_fe(:,:) = ( f_sbenin_fe(:,:) + f_fbenin_fe(:,:) - f_benout_fe(:,:) ) * rdt
+            za_sed_c(:,:)  = ( f_sbenin_c(:,:)  + f_fbenin_c(:,:)  - f_benout_c(:,:)  ) * rdt
+         endif
+         if (jinorgben.eq.1) then
+            za_sed_si(:,:) = ( f_fbenin_si(:,:) - f_benout_si(:,:) ) * rdt
+            za_sed_ca(:,:) = ( f_fbenin_ca(:,:) - f_benout_ca(:,:) ) * rdt
+         endif
+         !!
+         !! Leap-frog scheme - only in explicit case, otherwise the time stepping
+         !! is already being done in trczdf
+         !! IF( l_trczdf_exp .AND. (ln_trcadv_cen2 .OR. ln_trcadv_tvd) ) THEN
+         !!    zfact = 2. * rdttra(jk) * FLOAT( ndttrc )
+         !!    IF( neuler == 0 .AND. kt == nittrc000 )   zfact = rdttra(jk) * FLOAT(ndttrc)
+         !!    if (jorgben.eq.1) then
+         !!       za_sed_n(:,:)  = zb_sed_n(:,:)  + ( zfact * za_sed_n(:,:)  )
+         !!      za_sed_fe(:,:) = zb_sed_fe(:,:) + ( zfact * za_sed_fe(:,:) )
+         !!       za_sed_c(:,:)  = zb_sed_c(:,:)  + ( zfact * za_sed_c(:,:)  )
+         !!    endif
+         !!    if (jinorgben.eq.1) then
+         !!       za_sed_si(:,:) = zb_sed_si(:,:) + ( zfact * za_sed_si(:,:) )
+         !!       za_sed_ca(:,:) = zb_sed_ca(:,:) + ( zfact * za_sed_ca(:,:) )
+         !!    endif
+         !! ENDIF
+         !! 
+         !! Time filter and swap of arrays
+         IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd  ) THEN ! centred or tvd scheme
+            IF( neuler == 0 .AND. kt == nittrc000 ) THEN
+               if (jorgben.eq.1) then
+                  zb_sed_n(:,:)  = zn_sed_n(:,:)
+                  zn_sed_n(:,:)  = za_sed_n(:,:)
+                  za_sed_n(:,:)  = 0.0
+                  !!
+                  zb_sed_fe(:,:) = zn_sed_fe(:,:)
+                  zn_sed_fe(:,:) = za_sed_fe(:,:)
+                  za_sed_fe(:,:) = 0.0
+                  !!
+                  zb_sed_c(:,:)  = zn_sed_c(:,:)
+                  zn_sed_c(:,:)  = za_sed_c(:,:)
+                  za_sed_c(:,:)  = 0.0
+               endif
+               if (jinorgben.eq.1) then
+                  zb_sed_si(:,:) = zn_sed_si(:,:)
+                  zn_sed_si(:,:) = za_sed_si(:,:)
+                  za_sed_si(:,:) = 0.0
+                  !!
+                  zb_sed_ca(:,:) = zn_sed_ca(:,:)
+                  zn_sed_ca(:,:) = za_sed_ca(:,:)
+                  za_sed_ca(:,:) = 0.0
+               endif
+            ELSE
+               if (jorgben.eq.1) then
+                  zb_sed_n(:,:)  = (atfp  * ( zb_sed_n(:,:)  + za_sed_n(:,:)  )) + (atfp1 * zn_sed_n(:,:) )
+                  zn_sed_n(:,:)  = za_sed_n(:,:)
+                  za_sed_n(:,:)  = 0.0
+                  !!
+                  zb_sed_fe(:,:) = (atfp  * ( zb_sed_fe(:,:) + za_sed_fe(:,:) )) + (atfp1 * zn_sed_fe(:,:))
+                  zn_sed_fe(:,:) = za_sed_fe(:,:)
+                  za_sed_fe(:,:) = 0.0
+                  !!
+                  zb_sed_c(:,:)  = (atfp  * ( zb_sed_c(:,:)  + za_sed_c(:,:)  )) + (atfp1 * zn_sed_c(:,:) )
+                  zn_sed_c(:,:)  = za_sed_c(:,:)
+                  za_sed_c(:,:)  = 0.0
+               endif
+               if (jinorgben.eq.1) then
+                  zb_sed_si(:,:) = (atfp  * ( zb_sed_si(:,:) + za_sed_si(:,:) )) + (atfp1 * zn_sed_si(:,:))
+                  zn_sed_si(:,:) = za_sed_si(:,:)
+                  za_sed_si(:,:) = 0.0
+                  !!
+                  zb_sed_ca(:,:) = (atfp  * ( zb_sed_ca(:,:) + za_sed_ca(:,:) )) + (atfp1 * zn_sed_ca(:,:))
+                  zn_sed_ca(:,:) = za_sed_ca(:,:)
+                  za_sed_ca(:,:) = 0.0
+               endif
+            ENDIF
+         ELSE                   !  case of smolar scheme or muscl
+            if (jorgben.eq.1) then
+               zb_sed_n(:,:)  = za_sed_n(:,:)
+               zn_sed_n(:,:)  = za_sed_n(:,:)
+               za_sed_n(:,:)  = 0.0
+               !!
+               zb_sed_fe(:,:) = za_sed_fe(:,:)
+               zn_sed_fe(:,:) = za_sed_fe(:,:)
+               za_sed_fe(:,:) = 0.0
+               !!
+               zb_sed_c(:,:)  = za_sed_c(:,:)
+               zn_sed_c(:,:)  = za_sed_c(:,:)
+               za_sed_c(:,:)  = 0.0
+            endif
+            if (jinorgben.eq.1) then
+               zb_sed_si(:,:) = za_sed_si(:,:)
+               zn_sed_si(:,:) = za_sed_si(:,:)
+               za_sed_si(:,:) = 0.0
+               !!
+               zb_sed_ca(:,:) = za_sed_ca(:,:)
+               zn_sed_ca(:,:) = za_sed_ca(:,:)
+               za_sed_ca(:,:) = 0.0
+            endif
+         ENDIF
+      endif
+      
+      IF( ln_diatrc ) THEN
+         !!----------------------------------------------------------------------
+         !! Output several accumulated diagnostics
+         !!   - biomass-average phytoplankton limitation terms
+         !!   - integrated tendency terms
+         !!----------------------------------------------------------------------
+         !! 
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               !! non-diatom phytoplankton limitations
+               trc2d(ji,jj,25)  = trc2d(ji,jj,25) / MAX(ftot_pn(ji,jj), rsmall)
+               trc2d(ji,jj,26)  = trc2d(ji,jj,26) / MAX(ftot_pn(ji,jj), rsmall)
+               trc2d(ji,jj,27)  = trc2d(ji,jj,27) / MAX(ftot_pn(ji,jj), rsmall)
+               !! diatom phytoplankton limitations
+               trc2d(ji,jj,28)  = trc2d(ji,jj,28) / MAX(ftot_pd(ji,jj), rsmall)
+               trc2d(ji,jj,29)  = trc2d(ji,jj,29) / MAX(ftot_pd(ji,jj), rsmall)
+               trc2d(ji,jj,30)  = trc2d(ji,jj,30) / MAX(ftot_pd(ji,jj), rsmall)
+               trc2d(ji,jj,31)  = trc2d(ji,jj,31) / MAX(ftot_pd(ji,jj), rsmall)
+               trc2d(ji,jj,32)  = trc2d(ji,jj,32) / MAX(ftot_pd(ji,jj), rsmall)
+               !! tendency terms
+               trc2d(ji,jj,76)  = fflx_n(ji,jj)
+               trc2d(ji,jj,77)  = fflx_si(ji,jj)
+               trc2d(ji,jj,78)  = fflx_fe(ji,jj)
+               !! integrated biomass
+               trc2d(ji,jj,79)  = ftot_pn(ji,jj)       !! integrated non-diatom phytoplankton
+               trc2d(ji,jj,80)  = ftot_pd(ji,jj)       !! integrated diatom phytoplankton
+               trc2d(ji,jj,217) = ftot_zmi(ji,jj)      !! Integrated microzooplankton
+               trc2d(ji,jj,218) = ftot_zme(ji,jj)      !! Integrated mesozooplankton
+               trc2d(ji,jj,219) = ftot_det(ji,jj)      !! Integrated slow detritus, nitrogen
+               trc2d(ji,jj,220) = ftot_dtc(ji,jj)      !! Integrated slow detritus, carbon
+# if defined key_roam
+               !! the balance of nitrogen production/consumption
+               trc2d(ji,jj,111) = fnit_prod(ji,jj)  !! integrated nitrogen production
+               trc2d(ji,jj,112) = fnit_cons(ji,jj)  !! integrated nitrogen consumption
+               !! the balance of carbon production/consumption
+               trc2d(ji,jj,113) = fcar_prod(ji,jj)  !! integrated carbon production
+               trc2d(ji,jj,114) = fcar_cons(ji,jj)  !! integrated carbon consumption
+               !! the balance of oxygen production/consumption
+               trc2d(ji,jj,115) = foxy_prod(ji,jj)  !! integrated oxygen production
+               trc2d(ji,jj,116) = foxy_cons(ji,jj)  !! integrated oxygen consumption
+               trc2d(ji,jj,117) = foxy_anox(ji,jj)  !! integrated unrealised oxygen consumption
+# endif
+            ENDDO
+         ENDDO
+         
+# if defined key_roam
+#  if defined key_axy_nancheck
+         !!----------------------------------------------------------------------
+         !! Check for NaNs in diagnostic outputs
+         !!----------------------------------------------------------------------
+         !! 
+         !! 2D diagnostics
+         DO jn = 1,150
+            fq0 = SUM(trc2d(:,:,jn))
+            !! AXY (30/01/14): "isnan" problem on HECTOR
+            !! if (fq0 /= fq0 ) then
+            if ( ieee_is_nan( fq0 ) ) then
+               !! there's a NaN here
+               if (lwp) write(numout,*) 'NAN detected in 2D diagnostic field', jn, 'at time', kt, 'at position:'
+               DO jj = 1,jpj
+                  DO ji = 1,jpi
+                     if ( ieee_is_nan( trc2d(ji,jj,jn) ) ) then
+                        if (lwp) write (numout,'(a,3i6)') 'NAN-CHECK', &
+                        &        ji, jj, jn
+                     endif
+                  ENDDO
+               ENDDO
+	       CALL ctl_stop( 'trcbio_medusa, NAN in 2D diagnostic field' )
+            endif
+         ENDDO
+         !!
+         !! 3D diagnostics
+         DO jn = 1,5
+            fq0 = SUM(trc3d(:,:,:,jn))
+            !! AXY (30/01/14): "isnan" problem on HECTOR
+            !! if (fq0 /= fq0 ) then
+            if ( ieee_is_nan( fq0 ) ) then
+               !! there's a NaN here
+               if (lwp) write(numout,*) 'NAN detected in 3D diagnostic field', jn, 'at time', kt, 'at position:'
+               DO jk = 1,jpk
+                  DO jj = 1,jpj
+                     DO ji = 1,jpi
+                        if ( ieee_is_nan( trc3d(ji,jj,jk,jn) ) ) then
+                           if (lwp) write (numout,'(a,4i6)') 'NAN-CHECK', &
+                           &        ji, jj, jk, jn
+                        endif
+                     ENDDO
+                  ENDDO
+               ENDDO
+	       CALL ctl_stop( 'trcbio_medusa, NAN in 3D diagnostic field' )
+            endif
+         ENDDO
+	 CALL flush(numout)
+#  endif
+# endif
+
+         !!----------------------------------------------------------------------
+         !! Don't know what this does; belongs to someone else ...
+         !!----------------------------------------------------------------------
+         !! 
+         !! Lateral boundary conditions on trc2d
+         DO jn=1,jp_medusa_2d
+             CALL lbc_lnk(trc2d(:,:,jn),'T',1. )
+         ENDDO 
+
+         !! Lateral boundary conditions on trc3d
+         DO jn=1,jp_medusa_3d
+             CALL lbc_lnk(trc3d(:,:,1,jn),'T',1. )
+         ENDDO 
+
+
+# if defined key_axy_nodiag
+         !!----------------------------------------------------------------------
+         !! Blank diagnostics as a NaN-trap
+         !!----------------------------------------------------------------------
+         !! 
+         !! blank 2D diagnostic array
+         trc2d(:,:,:) = 0.e0
+         !!
+         !! blank 3D diagnostic array
+         trc3d(:,:,:,:) = 0.e0
+# endif
+
+
+         !!----------------------------------------------------------------------
+         !! Add in XML diagnostics stuff
+         !!----------------------------------------------------------------------
+         !!
+         !! ** 2D diagnostics
+         DO jn=1,jp_medusa_2d
+            CALL iom_put(TRIM(ctrc2d(jn)), trc2d(:,:,jn))
+         END DO
+!! AXY (17/02/14): don't think I need this if I modify the above for all diagnostics
+!! #  if defined key_roam
+!!          DO jn=91,jp_medusa_2d
+!!             CALL iom_put(TRIM(ctrc2d(jn)), trc2d(:,:,jn))
+!!          END DO      
+!! #  endif
+         !!
+         !! ** 3D diagnostics
+         DO jn=1,jp_medusa_3d
+            CALL iom_put(TRIM(ctrc3d(jn)), trc3d(:,:,:,jn))
+         END DO
+!! AXY (17/02/14): don't think I need this if I modify the above for all diagnostics
+!! #  if defined key_roam
+!!          CALL iom_put(TRIM(ctrc3d(5)), trc3d(:,:,:,5))
+!! #  endif
+
+
+      ELSE IF( lk_iomput .AND. .NOT. ln_diatrc ) THEN
+         !!!----------------------------------------------------------------------
+         !! Add very last diag calculations 
+         !!!----------------------------------------------------------------------
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               !!         
+               IF( med_diag%PN_JLIM%dgsave ) THEN
+                  fjln2d(ji,jj) = fjln2d(ji,jj)   / MAX(ftot_pn(ji,jj), rsmall)
+               ENDIF
+               IF( med_diag%PN_NLIM%dgsave ) THEN
+                  fnln2d(ji,jj) = fnln2d(ji,jj)   / MAX(ftot_pn(ji,jj), rsmall)
+               ENDIF
+               IF( med_diag%PN_FELIM%dgsave ) THEN
+                  ffln2d(ji,jj) = ffln2d(ji,jj)   / MAX(ftot_pn(ji,jj), rsmall)
+               ENDIF
+               IF( med_diag%PD_JLIM%dgsave ) THEN
+                  fjld2d(ji,jj) = fjld2d(ji,jj)   / MAX(ftot_pd(ji,jj), rsmall)
+               ENDIF
+               IF( med_diag%PD_NLIM%dgsave ) THEN
+                  fnld2d(ji,jj) = fnld2d(ji,jj)   / MAX(ftot_pd(ji,jj), rsmall)
+               ENDIF
+               IF( med_diag%PD_FELIM%dgsave ) THEN
+                  ffld2d(ji,jj) = ffld2d(ji,jj)   / MAX(ftot_pd(ji,jj), rsmall)
+               ENDIF
+               IF( med_diag%PD_SILIM%dgsave ) THEN
+                  fsld2d2(ji,jj) = fsld2d2(ji,jj) / MAX(ftot_pd(ji,jj), rsmall)
+               ENDIF
+               IF( med_diag%PDSILIM2%dgsave ) THEN
+                  fsld2d(ji,jj) = fsld2d(ji,jj)   / MAX(ftot_pd(ji,jj), rsmall)
+               ENDIF
+            ENDDO
+         ENDDO
+         !!----------------------------------------------------------------------
+         !! Add in XML diagnostics stuff
+         !!----------------------------------------------------------------------
+         !!
+         !! ** 2D diagnostics
+#   if defined key_debug_medusa
+         IF (lwp) write (numout,*) 'trc_bio_medusa: export all diag.'
+         CALL flush(numout)
+#   endif
+         IF ( med_diag%INVTN%dgsave ) THEN
+            CALL iom_put( "INVTN"  , ftot_n )
+         ENDIF
+         IF ( med_diag%INVTSI%dgsave ) THEN
+            CALL iom_put( "INVTSI"  , ftot_si )
+         ENDIF
+         IF ( med_diag%INVTFE%dgsave ) THEN
+            CALL iom_put( "INVTFE"  , ftot_fe )
+         ENDIF                           
+         IF ( med_diag%ML_PRN%dgsave ) THEN
+            CALL iom_put( "ML_PRN"  , fprn_ml )
+         ENDIF
+         IF ( med_diag%ML_PRD%dgsave ) THEN
+            CALL iom_put( "ML_PRD"  , fprd_ml )
+         ENDIF
+         IF ( med_diag%OCAL_LVL%dgsave ) THEN
+            CALL iom_put( "OCAL_LVL"  , fccd )
+         ENDIF
+         IF ( med_diag%PN_JLIM%dgsave ) THEN
+            CALL iom_put( "PN_JLIM"  , fjln2d )
+            CALL wrk_dealloc( jpi, jpj,   fjln2d   )
+         ENDIF
+         IF ( med_diag%PN_NLIM%dgsave ) THEN
+            CALL iom_put( "PN_NLIM"  , fnln2d )
+            CALL wrk_dealloc( jpi, jpj,   fnln2d   )
+         ENDIF
+         IF ( med_diag%PN_FELIM%dgsave ) THEN
+            CALL iom_put( "PN_FELIM"  , ffln2d )
+            CALL wrk_dealloc( jpi, jpj,   ffln2d   )
+         ENDIF
+         IF ( med_diag%PD_JLIM%dgsave ) THEN
+            CALL iom_put( "PD_JLIM"  , fjld2d )
+            CALL wrk_dealloc( jpi, jpj,  fjld2d    )
+         ENDIF
+         IF ( med_diag%PD_NLIM%dgsave ) THEN
+            CALL iom_put( "PD_NLIM"  , fnld2d )
+            CALL wrk_dealloc( jpi, jpj,   fnld2d  )
+         ENDIF
+         IF ( med_diag%PD_FELIM%dgsave ) THEN
+            CALL iom_put( "PD_FELIM"  , ffld2d )
+            CALL wrk_dealloc( jpi, jpj,  ffld2d    )
+         ENDIF
+         IF ( med_diag%PD_SILIM%dgsave ) THEN
+            CALL iom_put( "PD_SILIM"  , fsld2d2 )
+            CALL wrk_dealloc( jpi, jpj,   fsld2d2   )
+         ENDIF
+         IF ( med_diag%PDSILIM2%dgsave ) THEN
+            CALL iom_put( "PDSILIM2"  , fsld2d )
+            CALL wrk_dealloc( jpi, jpj,   fsld2d   )
+         ENDIF
+         IF ( med_diag%INTFLX_N%dgsave ) THEN
+            CALL iom_put( "INTFLX_N"  , fflx_n )
+         ENDIF
+         IF ( med_diag%INTFLX_SI%dgsave ) THEN
+            CALL iom_put( "INTFLX_SI"  , fflx_si )
+         ENDIF
+         IF ( med_diag%INTFLX_FE%dgsave ) THEN
+            CALL iom_put( "INTFLX_FE"  , fflx_fe )
+         ENDIF        
+         IF ( med_diag%INT_PN%dgsave ) THEN
+            CALL iom_put( "INT_PN"  , ftot_pn )
+         ENDIF
+         IF ( med_diag%INT_PD%dgsave ) THEN
+            CALL iom_put( "INT_PD"  , ftot_pd )
+         ENDIF         
+         IF ( med_diag%INT_ZMI%dgsave ) THEN
+            CALL iom_put( "INT_ZMI"  , ftot_zmi )
+         ENDIF
+         IF ( med_diag%INT_ZME%dgsave ) THEN
+            CALL iom_put( "INT_ZME"  , ftot_zme )
+         ENDIF
+         IF ( med_diag%INT_DET%dgsave ) THEN
+            CALL iom_put( "INT_DET"  , ftot_det )
+         ENDIF
+         IF ( med_diag%INT_DTC%dgsave ) THEN
+            CALL iom_put( "INT_DTC"  , ftot_dtc )
+         ENDIF
+         IF ( med_diag%BEN_N%dgsave ) THEN
+            CALL iom_put( "BEN_N"  , za_sed_n )
+         ENDIF
+         IF ( med_diag%BEN_FE%dgsave ) THEN
+            CALL iom_put( "BEN_FE"  , za_sed_fe )
+         ENDIF
+         IF ( med_diag%BEN_C%dgsave ) THEN
+            CALL iom_put( "BEN_C"  , za_sed_c )
+         ENDIF
+         IF ( med_diag%BEN_SI%dgsave ) THEN
+            CALL iom_put( "BEN_SI"  , za_sed_si )
+         ENDIF
+         IF ( med_diag%BEN_CA%dgsave ) THEN
+            CALL iom_put( "BEN_CA"  , za_sed_ca )
+         ENDIF
+         IF ( med_diag%RUNOFF%dgsave ) THEN
+            CALL iom_put( "RUNOFF"  , f_runoff )
+         ENDIF 
+# if defined key_roam        
+         IF ( med_diag%N_PROD%dgsave ) THEN
+            CALL iom_put( "N_PROD"  , fnit_prod )
+         ENDIF
+         IF ( med_diag%N_CONS%dgsave ) THEN
+            CALL iom_put( "N_CONS"  , fnit_cons )
+         ENDIF
+         IF ( med_diag%C_PROD%dgsave ) THEN
+            CALL iom_put( "C_PROD"  , fcar_prod )
+         ENDIF
+         IF ( med_diag%C_CONS%dgsave ) THEN
+            CALL iom_put( "C_CONS"  , fcar_cons )
+         ENDIF
+         IF ( med_diag%O2_PROD%dgsave ) THEN
+            CALL iom_put( "O2_PROD"  , foxy_prod )
+         ENDIF
+         IF ( med_diag%O2_CONS%dgsave ) THEN
+            CALL iom_put( "O2_CONS"  , foxy_cons )
+         ENDIF
+         IF ( med_diag%O2_ANOX%dgsave ) THEN
+            CALL iom_put( "O2_ANOX"  , foxy_anox )
+         ENDIF
+         IF ( med_diag%INVTC%dgsave ) THEN
+            CALL iom_put( "INVTC"  , ftot_c )
+         ENDIF
+         IF ( med_diag%INVTALK%dgsave ) THEN
+            CALL iom_put( "INVTALK"  , ftot_a )
+         ENDIF
+         IF ( med_diag%INVTO2%dgsave ) THEN
+            CALL iom_put( "INVTO2"  , ftot_o2 )
+         ENDIF
+         IF ( med_diag%COM_RESP%dgsave ) THEN
+            CALL iom_put( "COM_RESP"  , fcomm_resp )
+         ENDIF         
+# endif      
+         !!
+         !! diagnostic filled in the i-j-k main loop
+         !!--------------------------------------------
+         IF ( med_diag%PRN%dgsave ) THEN
+            CALL iom_put( "PRN"  , fprn2d )
+            CALL wrk_dealloc( jpi, jpj,   fprn2d   )
+         ENDIF
+         IF ( med_diag%MPN%dgsave ) THEN
+            CALL iom_put( "MPN"  ,fdpn2d  )
+            CALL wrk_dealloc( jpi, jpj,    fdpn2d  )
+         ENDIF
+         IF ( med_diag%PRD%dgsave ) THEN
+            CALL iom_put( "PRD"  ,fprd2d  )
+            CALL wrk_dealloc( jpi, jpj,   fprd2d  )
+         ENDIF
+         IF( med_diag%MPD%dgsave ) THEN
+            CALL iom_put( "MPD"  , fdpd2d )
+            CALL wrk_dealloc( jpi, jpj,    fdpd2d )
+         ENDIF
+         !  IF( med_diag%DSED%dgsave ) THEN
+         !      CALL iom_put( "DSED"  , ftot_n )
+         !  ENDIF
+         IF( med_diag%OPAL%dgsave ) THEN
+            CALL iom_put( "OPAL"  , fprds2d )
+            CALL wrk_dealloc( jpi, jpj,   fprds2d  )
+         ENDIF
+         IF( med_diag%OPALDISS%dgsave ) THEN
+            CALL iom_put( "OPALDISS"  , fsdiss2d )
+            CALL wrk_dealloc( jpi, jpj,   fsdiss2d  )
+         ENDIF
+         IF( med_diag%GMIPn%dgsave ) THEN
+            CALL iom_put( "GMIPn"  , fgmipn2d )
+            CALL wrk_dealloc( jpi, jpj,   fgmipn2d  )
+         ENDIF
+         IF( med_diag%GMID%dgsave ) THEN
+            CALL iom_put( "GMID"  , fgmid2d )
+            CALL wrk_dealloc( jpi, jpj,  fgmid2d  )
+         ENDIF
+         IF( med_diag%MZMI%dgsave ) THEN
+            CALL iom_put( "MZMI"  , fdzmi2d )
+            CALL wrk_dealloc( jpi, jpj,   fdzmi2d   )
+         ENDIF
+         IF( med_diag%GMEPN%dgsave ) THEN
+            CALL iom_put( "GMEPN"  , fgmepn2d )
+            CALL wrk_dealloc( jpi, jpj,   fgmepn2d  )
+         ENDIF
+         IF( med_diag%GMEPD%dgsave ) THEN
+            CALL iom_put( "GMEPD"  , fgmepd2d )
+            CALL wrk_dealloc( jpi, jpj,   fgmepd2d   )
+         ENDIF
+         IF( med_diag%GMEZMI%dgsave ) THEN
+            CALL iom_put( "GMEZMI"  , fgmezmi2d )
+            CALL wrk_dealloc( jpi, jpj,   fgmezmi2d   )
+         ENDIF
+         IF( med_diag%GMED%dgsave ) THEN
+            CALL iom_put( "GMED"  , fgmed2d )
+            CALL wrk_dealloc( jpi, jpj,    fgmed2d  )
+         ENDIF
+         IF( med_diag%MZME%dgsave ) THEN
+            CALL iom_put( "MZME"  , fdzme2d )
+            CALL wrk_dealloc( jpi, jpj,  fdzme2d    )
+         ENDIF
+         !  IF( med_diag%DEXP%dgsave ) THEN
+         !      CALL iom_put( "DEXP"  , ftot_n )
+         !  ENDIF
+         IF( med_diag%DETN%dgsave ) THEN
+            CALL iom_put( "DETN"  , fslown2d )
+            CALL wrk_dealloc( jpi, jpj,  fslown2d    )
+         ENDIF
+         IF( med_diag%MDET%dgsave ) THEN
+            CALL iom_put( "MDET"  , fdd2d )
+            CALL wrk_dealloc( jpi, jpj,   fdd2d   )
+         ENDIF
+         IF( med_diag%AEOLIAN%dgsave ) THEN
+            CALL iom_put( "AEOLIAN"  , ffetop2d )
+            CALL wrk_dealloc( jpi, jpj,   ffetop2d   )
+         ENDIF
+         IF( med_diag%BENTHIC%dgsave ) THEN
+            CALL iom_put( "BENTHIC"  , ffebot2d )
+            CALL wrk_dealloc( jpi, jpj,   ffebot2d   )
+         ENDIF
+         IF( med_diag%SCAVENGE%dgsave ) THEN
+            CALL iom_put( "SCAVENGE"  , ffescav2d )
+            CALL wrk_dealloc( jpi, jpj,   ffescav2d  )
+         ENDIF
+         !! 
+         IF( med_diag%TOTREG_N%dgsave ) THEN
+            CALL iom_put( "TOTREG_N"  , fregen2d )
+            CALL wrk_dealloc( jpi, jpj,   fregen2d   )
+         ENDIF
+         IF( med_diag%TOTRG_SI%dgsave ) THEN
+            CALL iom_put( "TOTRG_SI"  , fregensi2d )
+            CALL wrk_dealloc( jpi, jpj,    fregensi2d  )
+         ENDIF
+         !! 
+         IF( med_diag%FASTN%dgsave ) THEN
+            CALL iom_put( "FASTN"  , ftempn2d )
+            CALL wrk_dealloc( jpi, jpj,   ftempn2d   )
+         ENDIF
+         IF( med_diag%FASTSI%dgsave ) THEN
+            CALL iom_put( "FASTSI"  , ftempsi2d )
+            CALL wrk_dealloc( jpi, jpj,   ftempsi2d   )
+         ENDIF
+         IF( med_diag%FASTFE%dgsave ) THEN
+            CALL iom_put( "FASTFE"  , ftempfe2d )
+            CALL wrk_dealloc( jpi, jpj,    ftempfe2d  )
+         ENDIF
+         IF( med_diag%FASTC%dgsave ) THEN
+            CALL iom_put( "FASTC"  , ftempc2d )
+            CALL wrk_dealloc( jpi, jpj,  ftempc2d    )
+         ENDIF
+         IF( med_diag%FASTCA%dgsave ) THEN
+            CALL iom_put( "FASTCA"  , ftempca2d )
+            CALL wrk_dealloc( jpi, jpj,  ftempca2d   )
+         ENDIF
+         !! 
+         IF( med_diag%REMINN%dgsave ) THEN
+            CALL iom_put( "REMINN"  , freminn2d )
+            CALL wrk_dealloc( jpi, jpj,   freminn2d   )
+         ENDIF
+         IF( med_diag%REMINSI%dgsave ) THEN
+            CALL iom_put( "REMINSI"  , freminsi2d )
+            CALL wrk_dealloc( jpi, jpj,   freminsi2d   )
+         ENDIF
+         IF( med_diag%REMINFE%dgsave ) THEN
+            CALL iom_put( "REMINFE"  , freminfe2d )
+            CALL wrk_dealloc( jpi, jpj,  freminfe2d    )
+         ENDIF
+         IF( med_diag%REMINC%dgsave ) THEN
+            CALL iom_put( "REMINC"  , freminc2d )
+            CALL wrk_dealloc( jpi, jpj,    freminc2d  )
+         ENDIF
+         IF( med_diag%REMINCA%dgsave ) THEN
+            CALL iom_put( "REMINCA"  , freminca2d )
+            CALL wrk_dealloc( jpi, jpj,   freminca2d  )
+         ENDIF
+         IF( med_diag%SEAFLRN%dgsave ) THEN
+            CALL iom_put( "SEAFLRN"  , fsedn )
+         ENDIF
+         IF( med_diag%SEAFLRSI%dgsave ) THEN
+            CALL iom_put( "SEAFLRSI"  , fsedsi )
+         ENDIF
+         IF( med_diag%SEAFLRFE%dgsave ) THEN
+            CALL iom_put( "SEAFLRFE"  , fsedfe )
+         ENDIF
+         IF( med_diag%SEAFLRC%dgsave ) THEN
+            CALL iom_put( "SEAFLRC"  , fsedc )
+         ENDIF
+         IF( med_diag%SEAFLRCA%dgsave ) THEN
+            CALL iom_put( "SEAFLRCA"  , fsedca )
+         ENDIF
+         !!
+# if defined key_roam            
+         !!
+         IF( med_diag%RIV_N%dgsave ) THEN
+            CALL iom_put( "RIV_N"  , rivn2d )
+            CALL wrk_dealloc( jpi, jpj,    rivn2d  )
+         ENDIF
+         IF( med_diag%RIV_SI%dgsave ) THEN
+            CALL iom_put( "RIV_SI"  , rivsi2d )
+            CALL wrk_dealloc( jpi, jpj,   rivsi2d   )
+         ENDIF
+         IF( med_diag%RIV_C%dgsave ) THEN
+            CALL iom_put( "RIV_C"  , rivc2d )
+            CALL wrk_dealloc( jpi, jpj,    rivc2d  )
+         ENDIF
+         IF( med_diag%RIV_ALK%dgsave ) THEN
+            CALL iom_put( "RIV_ALK"  , rivalk2d )
+            CALL wrk_dealloc( jpi, jpj,  rivalk2d    )
+         ENDIF
+         IF( med_diag%DETC%dgsave ) THEN
+            CALL iom_put( "DETC"  , fslowc2d )
+            CALL wrk_dealloc( jpi, jpj,   fslowc2d   )
+         ENDIF
+         !!
+         IF( med_diag%PN_LLOSS%dgsave ) THEN
+            CALL iom_put( "PN_LLOSS"  , fdpn22d )
+            CALL wrk_dealloc( jpi, jpj,   fdpn22d   )
+         ENDIF
+         IF( med_diag%PD_LLOSS%dgsave ) THEN
+            CALL iom_put( "PD_LLOSS"  , fdpd22d )
+            CALL wrk_dealloc( jpi, jpj,   fdpd22d   )
+         ENDIF
+         IF( med_diag%ZI_LLOSS%dgsave ) THEN
+            CALL iom_put( "ZI_LLOSS"  , fdzmi22d )
+             CALL wrk_dealloc( jpi, jpj,    fdzmi22d  )
+          ENDIF
+          IF( med_diag%ZE_LLOSS%dgsave ) THEN
+             CALL iom_put( "ZE_LLOSS"  , fdzme22d )
+             CALL wrk_dealloc( jpi, jpj,   fdzme22d   )
+          ENDIF
+          IF( med_diag%ZI_MES_N%dgsave ) THEN
+             CALL iom_put( "ZI_MES_N"  , zimesn2d )
+             CALL wrk_dealloc( jpi, jpj,    zimesn2d  )
+          ENDIF
+          IF( med_diag%ZI_MES_D%dgsave ) THEN
+             CALL iom_put( "ZI_MES_D"  , zimesd2d )
+             CALL wrk_dealloc( jpi, jpj,    zimesd2d  )
+          ENDIF
+          IF( med_diag%ZI_MES_C%dgsave ) THEN
+             CALL iom_put( "ZI_MES_C"  , zimesc2d )
+             CALL wrk_dealloc( jpi, jpj,    zimesc2d  )
+          ENDIF
+          IF( med_diag%ZI_MESDC%dgsave ) THEN
+             CALL iom_put( "ZI_MESDC"  ,zimesdc2d  )
+             CALL wrk_dealloc( jpi, jpj,    zimesdc2d  )
+          ENDIF
+          IF( med_diag%ZI_EXCR%dgsave ) THEN
+             CALL iom_put( "ZI_EXCR"  , ziexcr2d )
+             CALL wrk_dealloc( jpi, jpj,    ziexcr2d )
+          ENDIF
+          IF( med_diag%ZI_RESP%dgsave ) THEN
+             CALL iom_put( "ZI_RESP"  , ziresp2d )
+             CALL wrk_dealloc( jpi, jpj,   ziresp2d   )
+          ENDIF
+          IF( med_diag%ZI_GROW%dgsave ) THEN
+             CALL iom_put( "ZI_GROW"  , zigrow2d )
+             CALL wrk_dealloc( jpi, jpj,   zigrow2d   )
+          ENDIF
+          IF( med_diag%ZE_MES_N%dgsave ) THEN
+             CALL iom_put( "ZE_MES_N"  , zemesn2d )
+             CALL wrk_dealloc( jpi, jpj,    zemesn2d  )
+          ENDIF
+          IF( med_diag%ZE_MES_D%dgsave ) THEN
+             CALL iom_put( "ZE_MES_D"  , zemesd2d )
+             CALL wrk_dealloc( jpi, jpj,    zemesd2d  )
+          ENDIF
+          IF( med_diag%ZE_MES_C%dgsave ) THEN
+             CALL iom_put( "ZE_MES_C"  , zemesc2d )
+             CALL wrk_dealloc( jpi, jpj,   zemesc2d   )
+          ENDIF
+          IF( med_diag%ZE_MESDC%dgsave ) THEN
+             CALL iom_put( "ZE_MESDC"  , zemesdc2d )
+             CALL wrk_dealloc( jpi, jpj,   zemesdc2d   )
+          ENDIF
+          IF( med_diag%ZE_EXCR%dgsave ) THEN
+             CALL iom_put( "ZE_EXCR"  , zeexcr2d )
+             CALL wrk_dealloc( jpi, jpj,   zeexcr2d   )
+          ENDIF
+          IF( med_diag%ZE_RESP%dgsave ) THEN
+             CALL iom_put( "ZE_RESP"  , zeresp2d )
+             CALL wrk_dealloc( jpi, jpj,    zeresp2d  )
+          ENDIF
+          IF( med_diag%ZE_GROW%dgsave ) THEN
+             CALL iom_put( "ZE_GROW"  , zegrow2d )
+             CALL wrk_dealloc( jpi, jpj,   zegrow2d   )
+          ENDIF
+          IF( med_diag%MDETC%dgsave ) THEN
+             CALL iom_put( "MDETC"  , mdetc2d )
+             CALL wrk_dealloc( jpi, jpj,   mdetc2d   )
+          ENDIF
+          IF( med_diag%GMIDC%dgsave ) THEN
+             CALL iom_put( "GMIDC"  , gmidc2d )
+             CALL wrk_dealloc( jpi, jpj,    gmidc2d  )
+          ENDIF
+          IF( med_diag%GMEDC%dgsave ) THEN
+             CALL iom_put( "GMEDC"  , gmedc2d )
+             CALL wrk_dealloc( jpi, jpj,    gmedc2d  )
+          ENDIF
+          IF( med_diag%IBEN_N%dgsave ) THEN
+             CALL iom_put( "IBEN_N"  , iben_n2d )
+             CALL wrk_dealloc( jpi, jpj,    iben_n2d  )
+          ENDIF
+          IF( med_diag%IBEN_FE%dgsave ) THEN
+             CALL iom_put( "IBEN_FE"  , iben_fe2d )
+             CALL wrk_dealloc( jpi, jpj,   iben_fe2d   )
+          ENDIF
+          IF( med_diag%IBEN_C%dgsave ) THEN
+             CALL iom_put( "IBEN_C"  , iben_c2d )
+             CALL wrk_dealloc( jpi, jpj,   iben_c2d   )
+          ENDIF
+          IF( med_diag%IBEN_SI%dgsave ) THEN
+             CALL iom_put( "IBEN_SI"  , iben_si2d )
+             CALL wrk_dealloc( jpi, jpj,   iben_si2d   )
+          ENDIF
+          IF( med_diag%IBEN_CA%dgsave ) THEN
+             CALL iom_put( "IBEN_CA"  , iben_ca2d )
+             CALL wrk_dealloc( jpi, jpj,   iben_ca2d   )
+          ENDIF
+          IF( med_diag%OBEN_N%dgsave ) THEN
+             CALL iom_put( "OBEN_N"  , oben_n2d )
+             CALL wrk_dealloc( jpi, jpj,    oben_n2d  )
+          ENDIF
+          IF( med_diag%OBEN_FE%dgsave ) THEN
+             CALL iom_put( "OBEN_FE"  , oben_fe2d )
+             CALL wrk_dealloc( jpi, jpj,    oben_fe2d  )
+          ENDIF
+          IF( med_diag%OBEN_C%dgsave ) THEN
+             CALL iom_put( "OBEN_C"  , oben_c2d )
+             CALL wrk_dealloc( jpi, jpj,    oben_c2d  )
+          ENDIF
+          IF( med_diag%OBEN_SI%dgsave ) THEN
+             CALL iom_put( "OBEN_SI"  , oben_si2d )
+             CALL wrk_dealloc( jpi, jpj,    oben_si2d  )
+          ENDIF
+          IF( med_diag%OBEN_CA%dgsave ) THEN
+             CALL iom_put( "OBEN_CA"  , oben_ca2d )
+             CALL wrk_dealloc( jpi, jpj, oben_ca2d     )
+          ENDIF
+          IF( med_diag%SFR_OCAL%dgsave ) THEN
+             CALL iom_put( "SFR_OCAL"  , sfr_ocal2d )
+             CALL wrk_dealloc( jpi, jpj,    sfr_ocal2d  )
+          ENDIF
+          IF( med_diag%SFR_OARG%dgsave ) THEN
+             CALL iom_put( "SFR_OARG"  , sfr_oarg2d )
+             CALL wrk_dealloc( jpi, jpj,    sfr_oarg2d  )
+          ENDIF
+          IF( med_diag%LYSO_CA%dgsave ) THEN
+             CALL iom_put( "LYSO_CA"  , lyso_ca2d )
+             CALL wrk_dealloc( jpi, jpj,    lyso_ca2d  )
+          ENDIF
+# endif                   
+          !!
+          !! ** 3D diagnostics
+          IF( med_diag%TPP3%dgsave ) THEN
+             CALL iom_put( "TPP3"  , tpp3d )
+             CALL wrk_dealloc( jpi, jpj, jpk,   tpp3d  )
+          ENDIF
+          IF( med_diag%DETFLUX3%dgsave ) THEN
+             CALL iom_put( "DETFLUX3"  , detflux3d )
+             CALL wrk_dealloc( jpi, jpj, jpk,    detflux3d )
+          ENDIF
+          IF( med_diag%REMIN3N%dgsave ) THEN
+             CALL iom_put( "REMIN3N"  , remin3dn )
+             CALL wrk_dealloc( jpi, jpj, jpk,   remin3dn  )
+          ENDIF
+# if defined key_roam          
+          IF( med_diag%PH3%dgsave ) THEN
+             CALL iom_put( "PH3"  , f3_pH )
+          ENDIF
+          IF( med_diag%OM_CAL3%dgsave ) THEN
+             CALL iom_put( "OM_CAL3"  , f3_omcal )
+          ENDIF
+          !!
+          !! AXY (09/11/16): 2D CMIP6 diagnostics
+          IF( med_diag%INTDISSIC%dgsave ) THEN
+             CALL iom_put( "INTDISSIC"  , intdissic )
+             CALL wrk_dealloc( jpi, jpj, intdissic   )
+          ENDIF          
+          IF( med_diag%INTDISSIN%dgsave ) THEN
+             CALL iom_put( "INTDISSIN"  , intdissin )
+             CALL wrk_dealloc( jpi, jpj, intdissin   )
+          ENDIF          
+          IF( med_diag%INTDISSISI%dgsave ) THEN
+             CALL iom_put( "INTDISSISI"  , intdissisi )
+             CALL wrk_dealloc( jpi, jpj, intdissisi  )
+          ENDIF          
+          IF( med_diag%INTTALK%dgsave ) THEN
+             CALL iom_put( "INTTALK"  , inttalk )
+             CALL wrk_dealloc( jpi, jpj, inttalk     )
+          ENDIF          
+          IF( med_diag%O2min%dgsave ) THEN
+             CALL iom_put( "O2min"  , o2min )
+             CALL wrk_dealloc( jpi, jpj, o2min       )
+          ENDIF          
+          IF( med_diag%ZO2min%dgsave ) THEN
+             CALL iom_put( "ZO2min"  , zo2min )
+             CALL wrk_dealloc( jpi, jpj, zo2min      )
+          ENDIF          
+          IF( med_diag%FBDDTALK%dgsave ) THEN
+             CALL iom_put( "FBDDTALK"  , fbddtalk   )
+             CALL wrk_dealloc( jpi, jpj, fbddtalk   )
+          ENDIF          
+          IF( med_diag%FBDDTDIC%dgsave ) THEN
+             CALL iom_put( "FBDDTDIC"  , fbddtdic   )
+             CALL wrk_dealloc( jpi, jpj, fbddtdic   )
+          ENDIF          
+          IF( med_diag%FBDDTDIFE%dgsave ) THEN
+             CALL iom_put( "FBDDTDIFE" , fbddtdife  )
+             CALL wrk_dealloc( jpi, jpj, fbddtdife  )
+          ENDIF          
+          IF( med_diag%FBDDTDIN%dgsave ) THEN
+             CALL iom_put( "FBDDTDIN"  , fbddtdin   )
+             CALL wrk_dealloc( jpi, jpj, fbddtdin   )
+          ENDIF          
+          IF( med_diag%FBDDTDISI%dgsave ) THEN
+             CALL iom_put( "FBDDTDISI" , fbddtdisi  )
+             CALL wrk_dealloc( jpi, jpj, fbddtdisi  )
+          ENDIF    
+          !!
+          !! AXY (09/11/16): 3D CMIP6 diagnostics
+          IF( med_diag%TPPD3%dgsave ) THEN
+             CALL iom_put( "TPPD3"     , tppd3 )
+             CALL wrk_dealloc( jpi, jpj, jpk, tppd3      )
+          ENDIF          
+          IF( med_diag%BDDTALK3%dgsave ) THEN
+             CALL iom_put( "BDDTALK3"  , bddtalk3 )
+             CALL wrk_dealloc( jpi, jpj, jpk, bddtalk3   )
+          ENDIF          
+          IF( med_diag%BDDTDIC3%dgsave ) THEN
+             CALL iom_put( "BDDTDIC3"  , bddtdic3 )
+             CALL wrk_dealloc( jpi, jpj, jpk, bddtdic3   )
+          ENDIF          
+          IF( med_diag%BDDTDIFE3%dgsave ) THEN
+             CALL iom_put( "BDDTDIFE3" , bddtdife3 )
+             CALL wrk_dealloc( jpi, jpj, jpk, bddtdife3  )
+          ENDIF          
+          IF( med_diag%BDDTDIN3%dgsave ) THEN
+             CALL iom_put( "BDDTDIN3"  , bddtdin3 )
+             CALL wrk_dealloc( jpi, jpj, jpk, bddtdin3   )
+          ENDIF          
+          IF( med_diag%BDDTDISI3%dgsave ) THEN
+             CALL iom_put( "BDDTDISI3" , bddtdisi3 )
+             CALL wrk_dealloc( jpi, jpj, jpk, bddtdisi3  )
+          ENDIF    
+          IF( med_diag%FD_NIT3%dgsave ) THEN
+             CALL iom_put( "FD_NIT3"  , fd_nit3 )
+             CALL wrk_dealloc( jpi, jpj, jpk,   fd_nit3  )
+          ENDIF
+          IF( med_diag%FD_SIL3%dgsave ) THEN
+             CALL iom_put( "FD_SIL3"  , fd_sil3 )
+             CALL wrk_dealloc( jpi, jpj, jpk,   fd_sil3  )
+          ENDIF
+          IF( med_diag%FD_CAL3%dgsave ) THEN
+             CALL iom_put( "FD_CAL3"  , fd_cal3 )
+             CALL wrk_dealloc( jpi, jpj, jpk,   fd_cal3  )
+          ENDIF
+          IF( med_diag%FD_CAR3%dgsave ) THEN
+             CALL iom_put( "FD_CAR3"  , fd_car3 )
+             CALL wrk_dealloc( jpi, jpj, jpk,   fd_car3  )
+          ENDIF
+          IF( med_diag%CO33%dgsave ) THEN
+             CALL iom_put( "CO33"  , f3_co3 )
+          ENDIF          	        
+          IF( med_diag%CO3SATARAG3%dgsave ) THEN
+             CALL iom_put( "CO3SATARAG3"  , f3_omarg )
+          ENDIF          	        
+          IF( med_diag%CO3SATCALC3%dgsave ) THEN
+             CALL iom_put( "CO3SATCALC3"  , f3_omcal )
+          ENDIF          	        
+          IF( med_diag%EXPC3%dgsave ) THEN
+             CALL iom_put( "EXPC3"  , expc3 )
+             CALL wrk_dealloc( jpi, jpj, jpk, expc3  )
+          ENDIF          	        
+          IF( med_diag%EXPN3%dgsave ) THEN
+             CALL iom_put( "EXPN3"  , expn3 )
+             CALL wrk_dealloc( jpi, jpj, jpk, expn3  )
+          ENDIF          	        
+          IF( med_diag%DCALC3%dgsave ) THEN
+             CALL iom_put( "DCALC3"  , dcalc3 )
+             CALL wrk_dealloc( jpi, jpj, jpk, dcalc3  )
+          ENDIF          	        
+          IF( med_diag%FEDISS3%dgsave ) THEN
+             CALL iom_put( "FEDISS3"  , fediss3 )
+             CALL wrk_dealloc( jpi, jpj, jpk, fediss3  )
+          ENDIF          	        
+          IF( med_diag%FESCAV3%dgsave ) THEN
+             CALL iom_put( "FESCAV3"  , fescav3 )
+             CALL wrk_dealloc( jpi, jpj, jpk, fescav3  )
+          ENDIF          	        
+          IF( med_diag%MIGRAZP3%dgsave ) THEN
+             CALL iom_put( "MIGRAZP3"  , migrazp3 )
+             CALL wrk_dealloc( jpi, jpj, jpk, migrazp3  )
+          ENDIF          	        
+          IF( med_diag%MIGRAZD3%dgsave ) THEN
+             CALL iom_put( "MIGRAZD3"  , migrazd3 )
+             CALL wrk_dealloc( jpi, jpj, jpk, migrazd3  )
+          ENDIF          	        
+          IF( med_diag%MEGRAZP3%dgsave ) THEN
+             CALL iom_put( "MEGRAZP3"  , megrazp3 )
+             CALL wrk_dealloc( jpi, jpj, jpk, megrazp3  )
+          ENDIF          	        
+          IF( med_diag%MEGRAZD3%dgsave ) THEN
+             CALL iom_put( "MEGRAZD3"  , megrazd3 )
+             CALL wrk_dealloc( jpi, jpj, jpk, megrazd3  )
+          ENDIF          	        
+          IF( med_diag%MEGRAZZ3%dgsave ) THEN
+             CALL iom_put( "MEGRAZZ3"  , megrazz3 )
+             CALL wrk_dealloc( jpi, jpj, jpk, megrazz3  )
+          ENDIF          	        
+          IF( med_diag%O2SAT3%dgsave ) THEN
+             CALL iom_put( "O2SAT3"  , o2sat3 )
+             CALL wrk_dealloc( jpi, jpj, jpk, o2sat3 )
+          ENDIF          	        
+          IF( med_diag%PBSI3%dgsave ) THEN
+             CALL iom_put( "PBSI3"  , pbsi3 )
+             CALL wrk_dealloc( jpi, jpj, jpk, pbsi3  )
+          ENDIF          	        
+          IF( med_diag%PCAL3%dgsave ) THEN
+             CALL iom_put( "PCAL3"  , pcal3 )
+             CALL wrk_dealloc( jpi, jpj, jpk, pcal3  )
+          ENDIF          	        
+          IF( med_diag%REMOC3%dgsave ) THEN
+             CALL iom_put( "REMOC3"  , remoc3 )
+             CALL wrk_dealloc( jpi, jpj, jpk, remoc3 )
+          ENDIF          	        
+          IF( med_diag%PNLIMJ3%dgsave ) THEN
+             CALL iom_put( "PNLIMJ3" , pnlimj3 )
+             CALL wrk_dealloc( jpi, jpj, jpk, pnlimj3  )
+          ENDIF          	        
+          IF( med_diag%PNLIMN3%dgsave ) THEN
+             CALL iom_put( "PNLIMN3" , pnlimn3 )
+             CALL wrk_dealloc( jpi, jpj, jpk, pnlimn3  )
+          ENDIF          	        
+          IF( med_diag%PNLIMFE3%dgsave ) THEN
+             CALL iom_put( "PNLIMFE3" , pnlimfe3 )
+             CALL wrk_dealloc( jpi, jpj, jpk, pnlimfe3 )
+          ENDIF          	        
+          IF( med_diag%PDLIMJ3%dgsave ) THEN
+             CALL iom_put( "PDLIMJ3" , pdlimj3 )
+             CALL wrk_dealloc( jpi, jpj, jpk, pdlimj3  )
+          ENDIF          	        
+          IF( med_diag%PDLIMN3%dgsave ) THEN
+             CALL iom_put( "PDLIMN3" , pdlimn3 )
+             CALL wrk_dealloc( jpi, jpj, jpk, pdlimn3  )
+          ENDIF          	        
+          IF( med_diag%PDLIMFE3%dgsave ) THEN
+             CALL iom_put( "PDLIMFE3" , pdlimfe3 )
+             CALL wrk_dealloc( jpi, jpj, jpk, pdlimfe3 )
+          ENDIF          	        
+          IF( med_diag%PDLIMSI3%dgsave ) THEN
+             CALL iom_put( "PDLIMSI3" , pdlimsi3 )
+             CALL wrk_dealloc( jpi, jpj, jpk, pdlimsi3 )
+          ENDIF          	        
+          
+# endif         
+
+          CALL wrk_dealloc( jpi, jpj,   zw2d   )
+
+       ENDIF                    ! end of ln_diatrc option
+
+# if defined key_trc_diabio
+       !! Lateral boundary conditions on trcbio
+       DO jn=1,jp_medusa_trd
+          CALL lbc_lnk(trbio(:,:,1,jn),'T',1. )
+       ENDDO 
+# endif
+
+# if defined key_debug_medusa
+       IF(lwp) WRITE(numout,*) ' MEDUSA exiting trc_bio_medusa at kt =', kt
+       CALL flush(numout)
+# endif
+
+   END SUBROUTINE trc_bio_medusa
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No MEDUSA bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE trc_bio_medusa( kt )                   ! Empty routine
+      INTEGER, INTENT( in ) ::   kt
+      WRITE(*,*) 'trc_bio_medusa: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_bio_medusa
+#endif 
+
+   !!======================================================================
+END MODULE  trcbio_medusa
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcco2_medusa.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcco2_medusa.F90	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcco2_medusa.F90	(revision 8201)
@@ -0,0 +1,1136 @@
+MODULE trcco2_medusa
+   !!======================================================================
+   !!                         ***  MODULE trcco2_medusa  ***
+   !! TOP :   MEDUSA
+   !!======================================================================
+   !! History :
+   !!  -   !  2010-12  (A. Yool)             added for ROAM project
+   !!----------------------------------------------------------------------
+#if defined key_medusa && defined key_roam
+   !!----------------------------------------------------------------------
+   !!                                        MEDUSA carbonate chemistry
+   !!----------------------------------------------------------------------
+   !!   trc_co2_medusa        :  
+   !!----------------------------------------------------------------------
+      USE oce_trc
+      USE trc
+      USE sms_medusa
+      USE lbclnk
+      USE prtctl_trc      ! Print control for debugging
+      USE in_out_manager  ! I/O manager
+
+      IMPLICIT NONE
+      PRIVATE
+      
+      PUBLIC   trc_co2_medusa    ! called in trc_bio_medusa
+
+   !!* Substitution
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+! The following is a map of the subroutines contained within this module
+! - trc_co2_medusa
+!      - CALLS CO2_dynamics
+!           - CALLS CO2DYN
+!		 - CALLS POLYCO
+!		      - CALLS CO2SET
+!		      - CALLS CO2CLC
+!           - CALLS CaCO3_Saturation
+!      - CALLS Air_sea_exchange
+
+CONTAINS
+
+!=======================================================================
+!
+      SUBROUTINE trc_co2_medusa( Temp, Sal, DIC, ALK, Depth, xkw, pCO2a, &
+      pH, pCO2w, h2co3, hco3, co3, om_cal, om_arg, co2flux, TDIC, TALK,  &
+      dcf, henry, iters )
+!      
+!=======================================================================
+!  
+! This file contains a set of FORTRAN subroutines that calculate the carbonate system 
+! at any given point in marine space time, given values for 
+! temperature, salinity, DIC, depth (pressure). 
+! This is essentially an implimentation of the Haltafall speciation code
+! (Ingri et al 1967, Talanta 14, 1261 - if it ain't broke don't fix it)
+! Another routine calulates the air sea exchange of CO2 given wind speed and atmospheric pCO2.
+! Code developed by Jerry blackford and others at PML, based on pre-existing code.
+! We accept no liability for errors or inaccuracies.
+! See Zeebe & Wolf-Gladrow, 2001. CO2 in seawater: equilibrium, kinetics and isotopes. 
+! Elsevier Oceanography Series 65, 346. for a reasonable overview. 
+! Many other packages exist, replicating the same functionality in different languages.
+! See http://cdiac.ornl.gov/oceans/co2rprt.html (CO2sys)
+! or  http://neon.otago.ac.nz/research/mfc/people/keith_hunter/software/swco2/
+! reference for prior usage of this code: Blackford & Gilbert, 2007. J Mar Sys 64, 229-241.
+! 
+! Modifications
+! 17/02/2010. Added conversion factor from per m3 to per kg (line 108-133)
+! 17/02/2010. Update calculation of K1, K2, Kb to make consistant with the OCMIP protocols.
+! 29/07/2011. Merged into MEDUSA with a raft of changes to this subroutine; less elsewhere
+! 23/06/2015. Modified to take gas transfer velocity as an input (rather than wind speed); 
+!             alter CO2 flux to /s rather than /d for consistency with other schemes
+!
+! Changes for MEDUSA include: 
+!     - making the program a module
+!     - passing in input variables (obvious given the last point)
+!     - making alkalinity a state variable (rather than a function of salinity)
+!
+      IMPLICIT NONE
+
+      REAL(wp), INTENT( in )    :: Temp       ! degrees C
+      REAL(wp), INTENT( in )    :: Sal        ! PSU
+      REAL(wp), INTENT( in )    :: DIC        ! mmol / m3
+      REAL(wp), INTENT( in )    :: ALK        ! meq  / m3
+      REAL(wp), INTENT( in )    :: Depth      ! m
+!     REAL(wp), INTENT( in )    :: Wnd        ! m / s
+      REAL(wp), INTENT( in )    :: xkw        ! m / s
+      REAL(wp), INTENT( in )    :: pCO2a      ! uatm
+!----------------------------------------------------------------------
+      REAL(wp), INTENT( inout ) :: pH         ! "normal" pH units
+      REAL(wp), INTENT( inout ) :: pCO2w      ! uatm
+      REAL(wp), INTENT( inout ) :: h2co3      ! mmol / m3
+      REAL(wp), INTENT( inout ) :: hco3       ! mmol / m3
+      REAL(wp), INTENT( inout ) :: co3        ! mmol / m3
+      REAL(wp), INTENT( inout ) :: om_cal     ! normalised
+      REAL(wp), INTENT( inout ) :: om_arg     ! normalised
+      REAL(wp), INTENT( inout ) :: co2flux    ! mmol / m2 / s
+      REAL(wp), INTENT( inout ) :: TDIC       ! umol / kg
+      REAL(wp), INTENT( inout ) :: TALK       ! ueq  / kg
+      REAL(wp), INTENT( inout ) :: dcf        ! m3 / kg
+      REAL(wp), INTENT( inout ) :: henry      ! ?
+      INTEGER,  INTENT( inout ) :: iters      ! # iterations to convergence
+!----------------------------------------------------------------------
+!     REAL(wp) :: cco2,bicarb,carb,henry
+      REAL(wp) :: cco2,bicarb,carb
+! ======================================================================
+
+! write inputs to screen
+!  WRITE(*,*) " "
+!  WRITE(*,'(A28)')       "    .........Inputs........."
+!  WRITE(*,'(A24,F10.3)') "    Temperature   (C) = ", Temp
+!  WRITE(*,'(A24,F10.3)') "    Salinity    (psu) = ", Sal
+!  WRITE(*,'(A24,F10.3)') "    Depth         (m) = ", Depth
+!  WRITE(*,'(A24,F10.3)') "    DIC     (mmol/m3) = ", DIC
+!  WRITE(*,'(A24,F10.3)') "    ALK      (ueq/m3) = ", ALK
+!  WRITE(*,'(A24,F10.3)') "    Wind speed  (m/s) = ", Wnd
+!  WRITE(*,'(A24,F10.3)') "    pCO2 atmos (uatm) = ", pCO2a
+
+! AXY (07/05/13) ==================================================
+! set total number of iterations to zero
+      iters = 0
+! AXY (07/05/13) ==================================================
+  
+   call CO2_dynamics( Temp, Sal, Depth, DIC, ALK, pCO2a, &                  ! inputs
+      pco2w, ph, h2co3, hco3, co3, henry, om_cal, om_arg, TDIC, TALK, &     ! outputs
+      dcf, iters)                                                           ! outputs
+
+   ! AXY (18/08/11): only do air-sea exchange calculation if depth = 0 
+   !                 (i.e. surface calculations being performed)
+   if (Depth .eq. 0.0) then
+      call Air_sea_exchange( Temp, xkw, pCO2w, pCO2a, henry, dcf, &         ! inputs
+         co2flux )                                                          ! output
+   else
+      co2flux = 0.0
+   endif      
+
+! AXY (09/01/14) ==================================================
+! check for non-convergence and NaNs
+   !!
+   if (iters .eq. 25) then
+      IF(lwp) WRITE(numout,*) ' trc_co2_medusa: ITERS WARNING, ', &
+      iters, ' AT depth =', Depth
+      IF(lwp) WRITE(numout,*) ' trc_co2_medusa: ztmp    =', Temp
+      IF(lwp) WRITE(numout,*) ' trc_co2_medusa: zsal    =', Sal
+      IF(lwp) WRITE(numout,*) ' trc_co2_medusa: zdic    =', DIC
+      IF(lwp) WRITE(numout,*) ' trc_co2_medusa: zalk    =', ALK
+      IF(lwp) WRITE(numout,*) ' trc_co2_medusa: f_kw660 =', xkw
+      IF(lwp) WRITE(numout,*) ' trc_co2_medusa: f_ph    =', ph
+      IF(lwp) WRITE(numout,*) ' trc_co2_medusa: f_pco2w =', pCO2w
+      IF(lwp) WRITE(numout,*) ' trc_co2_medusa: f_h2co3 =', h2co3
+      IF(lwp) WRITE(numout,*) ' trc_co2_medusa: f_hco3  =', hco3
+      IF(lwp) WRITE(numout,*) ' trc_co2_medusa: f_co3   =', co3
+   endif
+   !!
+   !! AXY (29/10/13): NaN checks
+   if (co2flux /= co2flux) then
+      !! if (lwp) write (numout,'(a,1pe10.2,4i6)') 'CO2FLUX-NAN', &
+      !! &        tmask(ji,jj,jk), kt, ji, jj, jk
+      if (lwp) write (numout,'(a,a,f10.3,a,f10.3)') 'CO2FLUX-NAN', &
+      &        ' TMP', Temp, ' SAL', Sal
+      if (lwp) write (numout,'(a,a,f10.3,a,f10.3)') 'CO2FLUX-NAN', &
+      &        ' DIC', DIC, ' ALK', ALK
+      if (lwp) write (numout,'(a,a,f10.3,a,f10.3)') 'CO2FLUX-NAN', &
+      &        ' XKW', xkw, ' PH ', ph
+      if (lwp) write (numout,'(a,a,i6)') 'CO2FLUX-NAN', &
+      &        ' ITERS', iters
+   endif
+   !!
+   !! AXY (09/01/14): NaN fudges
+   if (co2flux /= co2flux) then
+      ph      = 8.1
+      pCO2w   = pCO2a
+      h2co3   = 0.005 * DIC
+      hco3    = 0.865 * DIC
+      co3     = 0.130 * DIC
+      om_cal  = 4.
+      om_arg  = 2.
+      co2flux = 0.
+      TDIC    = DIC
+      TALK    = ALK
+      dcf     = 1.
+      henry   = 1.
+   endif
+! AXY (09/01/14) ==================================================
+
+! write outputs to screen
+!  WRITE(*,*) " "
+!  WRITE(*,'(A32,F10.3)') "    ..........Outputs..........."
+!  WRITE(*,'(A27,F10.3)') "    pH                 (pH) = ", pH
+!  WRITE(*,'(A27,F10.3)') "    DIC           (umol/kg) = ", TDIC
+!  WRITE(*,'(A27,F10.3)') "    TALK           (ueq/kg) = ", TALK
+!  WRITE(*,'(A27,F10.3)') "    pco2w            (uatm) = ", pco2w
+!  WRITE(*,'(A27,F10.3)') "    carbonic acid (mmol/m3) = ", h2co3
+!  WRITE(*,'(A27,F10.3)') "    bicarbonate   (mmol/m3) = ", bicarb
+!  WRITE(*,'(A27,F10.3)') "    carbonate     (mmol/m3) = ", carb
+!  WRITE(*,'(A27,F10.3)') "    Omega calcite       (~) = ", om_cal
+!  WRITE(*,'(A27,F10.3)') "    Omega aragonite     (~) = ", om_arg
+!  WRITE(*,'(A27,F10.3)') "    air sea flux(mmol/m2/s) = ", flux
+!  WRITE(*,*) " "
+
+   END SUBROUTINE trc_co2_medusa
+!-----------------------------------------------------------------------
+
+!=======================================================================
+!=======================================================================
+!=======================================================================
+
+!=======================================================================
+!
+      subroutine CO2_dynamics( T, S, Z, DIC, TALK, pco2a, &
+      pco2w, ph, h2co3, bicarb, carb, henry, om_cal, om_arg, TCO2, TA, &
+      dcf, iters )
+!      
+!=======================================================================
+!  
+   IMPLICIT NONE
+
+      REAL(wp), INTENT( in )    :: T          ! temperature (C)
+      REAL(wp), INTENT( in )    :: S          ! salinity (psu)
+      REAL(wp), INTENT( in )    :: Z          ! depth (metres)
+      REAL(wp), INTENT( in )    :: DIC        ! total dissolved inorganic carbon (mmol.m-3)
+      REAL(wp), INTENT( in )    :: TALK       ! total alkalinity (meq.m-3)
+      REAL(wp), INTENT( in )    :: pco2a      ! atmospheric pCO2
+!----------------------------------------------------------------------
+      REAL(wp), INTENT( inout ) :: pco2w      ! seawater pCO2
+      REAL(wp), INTENT( inout ) :: ph         ! seawater pH
+      REAL(wp), INTENT( inout ) :: h2co3      ! seawater carbonic acid (H2CO3)
+      REAL(wp), INTENT( inout ) :: bicarb     ! seawater bicarbonate ion (HCO3)
+      REAL(wp), INTENT( inout ) :: carb       ! seawater carbonate ion (CO3)
+      REAL(wp), INTENT( inout ) :: henry      ! Henry constant
+      REAL(wp), INTENT( inout ) :: om_cal     ! Omega calcite
+      REAL(wp), INTENT( inout ) :: om_arg     ! Omega aragonite
+      REAL(wp), INTENT( inout ) :: TCO2       ! total dissolved inorganic carbon (mol.kg-1)
+      REAL(wp), INTENT( inout ) :: TA         ! total alkalinity (eq.kg-1)
+      REAL(wp), INTENT( inout ) :: dcf        ! density conversion factor
+      INTEGER,  INTENT( inout ) :: iters      ! # iterations to convergence
+!----------------------------------------------------------------------
+      REAL(wp) :: a, b, c
+      REAL(wp) :: ca, bc, cb
+      REAL(wp) :: pco2water, fairco2
+
+! ======================================================================
+
+! Adjust to correct units.
+! Haltafall uses mol/kg rather than umol/kg necessitating a scaling factor of /1.0D6
+! DIC (mmol/m3) needs to be converted to umol/kg via the calculation of water density at prevailing T&S
+! sea-water density (Millero & Poisson, Deep-Sea Research, 1981, also known as UNESCO, 1981)
+! with T: Temperature in degree Celsius; S: Salinity in practical units, density in kg/m3
+! valid for 0<T<40 and 0.5<S<43. Density Conversion factor (dcf) = * density * 1.0D3
+
+          a   =  8.24493d-1 - 4.0899d-3*T +  7.6438d-5*T**2 - 8.2467d-7*T**3 + 5.3875d-9*T**4
+          b   = -5.72466d-3 + 1.0227d-4*T - 1.6546d-6*T**2 
+          c   = 4.8314d-4
+          dcf = (999.842594 + 6.793952d-2*T- 9.095290d-3*T**2 + 1.001685d-4*T**3 &
+                - 1.120083d-6*T**4 + 6.536332d-9*T**5+a*S+b*S**1.5+c*S**2)/1.0D3
+
+          TA    = TALK / (1.0D6*dcf)
+          TCO2  = DIC  / (1.0D6*dcf)
+
+! Call the parent routine for the carbonate system
+          CALL CO2DYN ( TCO2, TA, T, S, pco2a, &     ! inputs
+          pco2water, pH, HENRY, ca, bc, cb, iters )  ! outputs
+
+! Adjust outputs back to units used in the parent model code (e.g. mmol/m3) if appropriate
+
+          pco2w  = pco2water * (1.0D6) 	! partial pressure of co2 in water 
+          TA     = TA * (1.0D6)         ! total alkalinity (umol/kg)
+          h2co3  = ca * (1.0D6*dcf)     ! carbonic acid concentration (mmol/m3)
+          bicarb = bc * (1.0D6*dcf)     ! bicarbonate ion concentration (mmol/m3)
+          carb   = cb * (1.0D6*dcf)     ! carbonate ion concentration (mmol/m3)
+          TCO2   = TCO2 * (1.0D6)       ! total C or DIC in units of umol/kg
+
+! Call carbonate saturation state subroutine to calculate calcite and aragonite calcification states
+
+          CALL CaCO3_Saturation ( T, S, Z, cb, &  ! inputs
+          om_cal, om_arg )                        ! outputs
+
+   RETURN
+
+   END SUBROUTINE CO2_dynamics
+!-----------------------------------------------------------------------
+
+!=======================================================================
+!=======================================================================
+!=======================================================================
+
+!=======================================================================
+!
+      SUBROUTINE Air_sea_exchange( T, xkw, pco2w, pco2a, henry, dcf, &
+      flux )
+!      
+!=======================================================================
+!  
+!  This routine should be called for the surface box only (like, duh)
+!  Uses the Nightingale and Liss parameterisation (GBC 14, 373-388 (2000).
+!  SC is the Schmidt number from Wanninkhof (1992, JGR 97,7373-7382), the Nightingale et al (2000)
+!  transfer velocity being for Sc=600 and the dependence of tranfer velocity on Sc coming 
+!  from Jahne et al (1987, J. Geophys Res 92, 1937-1949).
+
+!  Inputs
+!  pCO2w    partial pressure of CO2 in the water (from carbonate system subroutine call)
+!  pCO2a    partial pressure of CO2 in the atmosphere (usually external forcing).
+!  T        temperature (C)
+!  Wnd      wind speed, metres (DELETED)
+!  xkw      gas transfer velocity
+!  Henry    henry's constant
+!  density  the density of water for conversion between mmol/m3 and umol/kg
+
+!  Outputs are
+!  flux     flux of CO2 in mmol C /m2/d 
+!           +ve is in-gassing (air to sea), -ve is outgassing (sea to air).
+
+   IMPLICIT NONE
+
+      REAL(wp), INTENT( in )    :: T, xkw, pco2w, pco2a, henry, dcf ! INPUT PARAMETERS:
+!-----------------------------------------------------------------------
+      REAL(wp), INTENT( inout ) :: flux                             ! OUTPUT Variables
+!-----------------------------------------------------------------------
+      REAL(wp)                  :: sc, fwind                        ! LOCAL VARIABLES:
+
+! calculate the Schmidt number and unit conversions
+          sc    = 2073.1-125.62*T+3.6276*T**2.0-0.0432190*T**3.0
+!         fwind = (0.222d0 * wnd**2d0 + 0.333d0 * wnd)*(sc/660.d0)**(-0.5)
+          fwind = xkw * (sc/660.d0)**(-0.5)
+          fwind = fwind*24.d0/100.d0   ! convert to m/day
+
+! flux depends on the difference in partial pressures, wind and henry
+! here it is rescaled to mmol/m2/d
+          flux = fwind * henry * ( pco2a - pco2w ) * dcf
+
+! AXY (23/06/15): let's get it from /d to /s
+          flux = flux / ( 86400. )
+
+  RETURN 
+
+  END SUBROUTINE Air_sea_exchange
+!-----------------------------------------------------------------------
+
+!=======================================================================
+!=======================================================================
+!=======================================================================
+
+!=======================================================================
+!
+      SUBROUTINE CO2dyn ( TCO2, TA, T, S, PCO2A, PCO2, PH, HENRY, ca, bc, cb, iters )
+!      
+!=======================================================================
+!
+!     This subroutine acts as an interface to the Haltafall iteration, setting options etc.
+
+      REAL(wp), INTENT( in )    :: TCO2, TA, T, S, PCO2A
+!-----------------------------------------------------------------------
+      REAL(wp), INTENT( inout ) :: PCO2, PH, HENRY, ca, bc, cb
+      INTEGER,  INTENT( inout ) :: iters
+!-----------------------------------------------------------------------
+      REAL(wp) :: PRSS
+      INTEGER  :: MCONC, MKVAL, ICONST, ICALC
+
+      PARAMETER ( MCONC = 9,MKVAL = 4 )
+
+      REAL(wp), DIMENSION(MKVAL) :: AKVAL
+      REAL(wp), DIMENSION(MCONC) :: CONCS
+
+      ICONST = 6
+      PRSS = 1.0D0
+      CONCS(1) = TCO2
+      CONCS(2) = TA
+      ICALC = 1
+      
+      CALL POLYCO(PRSS,T,S,CONCS,MCONC,AKVAL,MKVAL,ICALC,ICONST,iters)
+
+      if(iters.eq.25) then
+         ! AXY (13/05/13): this location has failed to converge; use
+         !                 some standard values to plug the hole
+         CONCS(3) = PCO2A * 1E-06 ! atmospheric value
+         CONCS(4) = 8.1           ! global average pH
+         CONCS(5) = TCO2 * 0.005  ! some "standard" values plucked
+         CONCS(6) = TCO2 * 0.865  ! from pages 5-6 of Zeebe & Wolf-
+         CONCS(7) = TCO2 * 0.130  ! Gladow (2001)
+         AKVAL(1) = 0.5E-01       ! trial-and-error value
+         IF(lwp) THEN
+            WRITE(numout,*) ' CO2DYN : reset failed outputs'
+         ENDIF
+      endif
+
+      PCO2  = CONCS(3)
+      PH    = CONCS(4)
+      ca    = CONCS(5)
+      bc    = CONCS(6)
+      cb    = CONCS(7)
+      HENRY = AKVAL(1)
+    
+      RETURN
+
+      END SUBROUTINE
+!-----------------------------------------------------------------------
+
+!=======================================================================
+!=======================================================================
+!=======================================================================
+
+!=======================================================================
+!
+      SUBROUTINE POLYCO(PD,TD,SD,CONCS,NCONC,AKVAL,NKVAL,ICALC,ICONST,iters)
+!      
+!=======================================================================
+!
+! MASTER SUBROUTINE FOR CALCULATION OF THE CO2 SYSTEM THERMODYNAMICS
+!
+! EXPLANATION OF POLYCO PARAMETERS
+!       AXY (16/08/11): Yuri change for non-surface carbonate chemistry 
+!       P - PRESSURE IN ATMOSPHERES (P<>1 CODED only for ICONST=3 and ICONST=6)
+!       T - TEMPERATURE IN DEG.C
+!       S - SALINITY IN PPT
+!      CONCS(1) - TOTAL C (MOL/KG)
+!      CONCS(2) - TOTAL ALKALINITY (MOL/KG)
+!      CONCS(3) - PCO2 (ATM)
+!      CONCS(4) - PH
+!      CONCS(5) - {H2CO3} (MOL/KG)
+!      CONCS(6) - {HCO3} (MOL/KG)
+!      CONCS(7) - {CO3} (MOL/KG)
+!        CONCS(8) - CARBONATE ALKALINITY  ) FOR ICONST = 4,5,6
+!        CONCS(9) - BORATE ALKALINITY     )       ONLY
+!         NCONC - SIZE OF CONCS ARRAY (7 FOR ICONST=1,2,3; 9 FOR ICONST
+!     AKVAL(1) - KP (HENRY'S LAW CONSTANT) (MOL/KG/ATM)
+!     AKVAL(2) - K1C (H2CO3 DISSOCIATION) (MOL/KG)
+!       AKVAL(3) - K2C (HCO3 DISSOCIATION) (MOL/KG)
+!       AKVAL(4) - KB (B(OH)3 DISSOCIATION) (MOL/KG)  FOR ICONST=4,5,6
+!        NKVAL - SIZE OF AKVAL ARRAY (3 FOR ICONST=1,2,3; 4 FOR ICONST=
+!        ICALC - SELECTION OF THE TWO INPUT PARAMETERS:
+!       ICALC = 1  TOTAL C AND ALKALINITY
+!       ICALC = 2  TOTAL C AND PCO2
+!       ICALC = 3  TOTAL C AND PH
+!       ICALC = 4  ALKALINITY AND PCO2
+!       ICALC = 5  ALKALINITY AND PH
+!       ICALC = 6  PCO2 AND PH
+!       ICALC = 7  CALCULATE CONSTANTS AKVAL ONLY
+!       ICONST - SELECTION OF PH SCALE AND COMPONENTS:
+!       ICONST = 1  NBS PH SCALE
+!       ICONST = 2  HANSSON'S SCALE (SWS WITHOUT FLUORIDE)
+!       ICONST = 3  SWS PH SCALE
+!       ICONST = 4  AS 1 BUT INCLUDING BORATE IN THE CALCULATION
+!       ICONST = 5  AS 2 BUT INCLUDING BORATE IN THE CALCULATION
+!       ICONST = 6  AS 3 BUT INCLUDING BORATE IN THE CALCULATION
+
+!  NOTE: FOR ICONST=1,2,3 CONCS(2) REPRESENTS CARBONATE ALKALINITY SINC
+!        BORATE IS NOT INCLUDED IN THE CALCULATION. FOR ICONST=4,5,6 CO
+!        REPRESENTS TOTAL ALKALINITY (CARBONATE + BORATE), THE COMPONEN
+!        WHICH ARE GIVEN IN CONCS(8) AND CONCS(9)
+
+      REAL(wp) :: PMIN, PMAX, SMIN, SMAX, TMIN, TMAX, & 
+     &     PD, TD, SD, P, T, S, BTOT
+      INTEGER  :: MINJC, MAXJC, MINJK, MAXJK, MINCAL, MAXCAL, MINCON,  &
+     &     MAXCON, NCONC, NKVAL, ICALC, ICONST, IC, iters
+      LOGICAL  :: BORON
+
+      PARAMETER(MINJC=7,MAXJC=9,MINJK=3,MAXJK=4)
+      PARAMETER(MINCAL=1,MAXCAL=7,MINCON=1,MAXCON=6)
+      !! AXY (11/08/11): TMIN changed to -2 to stop error messages in polar regions
+      !! AXY (09/01/14): TMIN changed to -3 to stop error messages in polar regions
+      !! AXY (03/03/14): SMAX changed to 42 to stop error messages in salty regions (the Great Answer ...)
+      !! AXY (05/03/14): SMAX changed to 45 to stop error messages in salty regions
+      PARAMETER(PMIN=0.99999D0,PMAX=1.00001D0,SMIN=0.0D0,  &
+     &  SMAX=45.0D0,TMIN=-3.0D0,TMAX=40.0D0)
+      REAL(wp), DIMENSION(NKVAL) :: AKVAL
+      REAL(wp), DIMENSION(NCONC) :: CONCS
+
+      P = PD
+      S = SD
+      T = TD
+      
+      !! AXY (09/08/11): STOP statements commented out and WARNING messages added
+      IF(lwp) THEN
+         IF(T.LT.TMIN.OR.T.GT.TMAX) WRITE(numout,*) ' trc_co2_medusa: T WARNING, ', T, TMIN, TMAX, S, P
+         IF(S.LT.SMIN.OR.S.GT.SMAX) WRITE(numout,*) ' trc_co2_medusa: S WARNING, ', S, SMIN, SMAX, T, P
+         IF(P.LT.PMIN.OR.P.GT.PMAX) WRITE(numout,*) ' trc_co2_medusa: P WARNING, ', P, PMIN, PMAX, T, S
+      ENDIF
+      ! IF(T.LT.TMIN.OR.T.GT.TMAX)WRITE (*,*) P, S, T, TMIN, TMAX
+      ! IF(P.LT.PMIN.OR.P.GT.PMAX) STOP'POLYCO - PRESSURE OUT OF RANGE'
+      ! IF(S.LT.SMIN.OR.S.GT.SMAX) STOP'POLYCO - SALINITY OUT OF RANGE'
+      ! IF(T.LT.TMIN.OR.T.GT.TMAX) STOP'POLYCO - TEMP. OUT OF RANGE'
+
+      !! AXY (17/04/13): iMARNET climate change simulation appears to be compromised
+      !!                 by excessive Caspian Sea salinity (> 45 PSU); this may be
+      !!                 a runoff glitch that doesn't manifest on local instance of
+      !!                 NEMO; fudging this here by replacing excessively high
+      !!                 salinity values with maximum salinity value for the purpose
+      !!                 of carbonate chemistry calculations; if this works, a more
+      !!                 sensible solution might be to kill Caspian, etc.
+      IF(lwp) THEN
+         IF(S.LT.SMIN) THEN
+            WRITE(numout,*) ' trc_co2_medusa: S RESET, ', S, '->', SMIN
+            S = SMIN
+         ENDIF
+         IF(S.GT.SMAX) THEN
+            WRITE(numout,*) ' trc_co2_medusa: S RESET, ', S, '->', SMAX
+            S = SMAX
+         ENDIF
+      ENDIF
+      
+      !! AXY (28/02/13): as above, but for T; this has been done for 1/4-degree
+      !!                 simulations to provide a temporary fix to a strange
+      !!                 glitch in ocean temperature; basically, T has been found
+      !!                 to spike upwards arbitrarily (e.g. 24C -> 53C); this 
+      !!                 causes the carbonate chemistry calculations to fail;
+      !!                 this fix aims to stop the problem so that we can estimate
+      !!                 how frequent a problem this is; it's suggestive of a
+      !!                 memory leak
+      IF(lwp) THEN
+         IF(T.LT.TMIN) THEN
+            WRITE(numout,*) ' trc_co2_medusa: T RESET, ', T, '->', TMIN
+            T = TMIN
+         ENDIF
+         IF(T.GT.TMAX) THEN
+            WRITE(numout,*) ' trc_co2_medusa: T RESET, ', T, '->', TMAX
+            T = TMAX
+         ENDIF
+      ENDIF
+     
+      IF(ICALC.LT.MINCAL.OR.ICALC.GT.MAXCAL) STOP 'POLYCO - ICALC OUT OR RANGE'
+      IF(ICONST.LT.MINCON.OR.ICONST.GT.MAXCON) STOP 'POLYCO - ICONST OUT OF RANGE'
+      BORON=(ICONST.GT.3)
+      IF(BORON) THEN
+        IC=ICONST-3
+        BTOT=0.0004128D0*S/35.0D0
+        IF(NCONC.NE.MAXJC) STOP 'POLYCO - WRONG NCONC VALUE'
+        IF(NKVAL.NE.MAXJK) STOP 'POLYCO - WRONG NKVAL VALUE'
+      ELSE
+        IC=ICONST
+        IF(NCONC.NE.MINJC) STOP 'POLYCO - WRONG NCONC VALUE'
+        IF(NKVAL.NE.MINJK) STOP 'POLYCO - WRONG NKVAL VALUE'
+      ENDIF
+
+      CALL CO2SET(P,T,S,AKVAL,NKVAL,IC)
+
+      IF(ICALC.LT.MAXCAL)  &
+     & CALL CO2CLC(CONCS,NCONC,AKVAL,NKVAL,ICALC,BORON,BTOT,iters)
+
+      RETURN
+
+      END SUBROUTINE
+!-----------------------------------------------------------------------
+
+!=======================================================================
+!=======================================================================
+!=======================================================================
+
+!=======================================================================
+!
+      SUBROUTINE CO2SET(P,T,S,AKVAL,NKVAL,IC)
+!      
+!=======================================================================
+!
+! Routine to calculate CO2 system constants under the conditions set by
+! P,S,T     (NOTE: PRESSURE <> 1ATM IS NOT YET CODED)
+
+! I. Calculate constants at P=1 and S=0 using
+
+!      ln K0  =  A + B/TK + C ln TK
+!                                   (where TK is in Kelvin)
+
+! II. Calculate constants at P=1 and salinity S using
+
+!    ln K  =  ln K0 + (a0 + a1/TK + a2 ln TK) S**1/2
+!                 + (b0 + b1TK + b2TK**2) S
+
+! The sources of the coefficients are as follows:
+
+!  IC=                  1                    2                  3
+!               (NBS pH scale)        (SWS pH scale       (SWS pH scale
+!                                       with no F)
+
+!  KP            WEISS (1974)           WEISS(1974)          WEISS(1974
+
+!  K1C )      MEHRBACH ACC. TO       HANSSON ACC. TO    HANSSON AND MEH
+!  K2C )       MILLERO (1979)         MILLERO (1979)      ACC. TO DICKS
+!   KB )                                                 AND MILLERO (1
+!                                                         (K1C AND K2C
+!                                                           HANSSON ACC
+!                                                            MILLERO (1
+!                                                              (KB ONLY
+
+! ***
+!      IMPLICIT real*8 (A-H,O-Z)
+
+!     Modified by jcb 17/02/10 to use OCMIP calculations of K1, K2, Kb. 
+!     Differences are subtle rather than significant
+
+      INTEGER             :: MAXK, MAXCON, NKVAL, ICON, IC, IK
+! ***
+      PARAMETER(MAXK=4,MAXCON=3)
+      REAL(wp), DIMENSION(MAXK)        :: A, B, C
+      REAL(wp), DIMENSION(MAXK,MAXCON) :: A0, A1, A2
+      REAL(wp), DIMENSION(MAXK,MAXCON) :: B0, B1, B2
+      REAL(wp), DIMENSION(NKVAL)       :: AKVAL
+!     AXY (16/08/11): Yuri change for non-surface carbonate chemistry 
+!     REAL(wp)            :: P,T,S,VAL,TK
+      REAL(wp)            :: P,T,S,VAL,TK, delta, kappa, Rgas
+      REAL(wp)            :: dlogTK, S2, sqrtS, S15, k1, k2, kb
+! ***
+!     AXY (16/08/11): Yuri change for non-surface carbonate chemistry 
+      DATA Rgas/83.131/
+
+      DATA A/-167.8108D0, 290.9097D0, 207.6548D0, 148.0248D0/
+      DATA B/9345.17D0, -14554.21D0, -11843.79D0, -8966.9D0/
+      DATA C/23.3585D0, -45.0575D0, -33.6485D0, -24.4344D0/
+      DATA (A0(1,ICON),ICON=1,MAXCON) /3*0.0D0/
+      DATA (A0(2,ICON),ICON=1,MAXCON) /0.0221D0, 0.5709D0, -45.8076D0/
+      DATA (A0(3,ICON),ICON=1,MAXCON) /0.9805D0, 1.4853D0, -39.5492D0/
+      DATA (A0(4,ICON),ICON=1,MAXCON) /0.0473D0, 0.5998D0, 0.5998D0/
+      DATA (A1(1,ICON),ICON=1,MAXCON) /3*0.0D0/
+      DATA (A1(2,ICON),ICON=1,MAXCON) /34.02D0, -84.25D0, 1935.07D0/
+      DATA (A1(3,ICON),ICON=1,MAXCON) /-92.65D0, -192.69D0, 1590.14D0/
+      DATA (A1(4,ICON),ICON=1,MAXCON) /49.10D0, -75.25D0, -75.25D0/
+      DATA (A2(1,ICON),ICON=1,MAXCON) /3*0.0D0/
+      DATA (A2(2,ICON),ICON=1,MAXCON) /2*0.0D0,6.9513D0/
+      DATA (A2(3,ICON),ICON=1,MAXCON) /2*0.0D0,6.1523D0/
+      DATA (A2(4,ICON),ICON=1,MAXCON) /3*0.0D0/
+      DATA (B0(1,ICON),ICON=1,MAXCON) /3*0.023517D0/
+      DATA (B0(2,ICON),ICON=1,MAXCON) /0.0D0,-0.01632D0,-0.01566D0/
+      DATA (B0(3,ICON),ICON=1,MAXCON) /-0.03294D0,-0.05058D0,-0.04997D0/
+      DATA (B0(4,ICON),ICON=1,MAXCON) /0.0D0, -0.01767D0, -0.01767D0/
+      DATA (B1(1,ICON),ICON=1,MAXCON) /3*-2.3656D-4/
+      DATA (B1(2,ICON),ICON=1,MAXCON) /3*0.0D0/
+      DATA (B1(3,ICON),ICON=1,MAXCON) /3*0.0D0/
+      DATA (B1(4,ICON),ICON=1,MAXCON) /3*0.0D0/
+      DATA (B2(1,ICON),ICON=1,MAXCON) /3*4.7036D-7/
+      DATA (B2(2,ICON),ICON=1,MAXCON) /3*0.0D0/
+      DATA (B2(3,ICON),ICON=1,MAXCON) /3*0.0D0/
+      DATA (B2(4,ICON),ICON=1,MAXCON) /3*0.0D0/
+
+      TK=T+273.15D0
+      DO 100 IK=1,NKVAL
+        VAL=A(IK) + B(IK)/TK + C(IK)*LOG(TK)
+        VAL=VAL + (A0(IK,IC) + A1(IK,IC)/TK + A2(IK,IC)*LOG(TK))*SQRT(S)
+        VAL=VAL + (B0(IK,IC) + B1(IK,IC)*TK + B2(IK,IC)*TK*TK)*S
+        AKVAL(IK)=EXP(VAL)
+100    CONTINUE
+
+      IF (IC .EQ. 3) THEN
+!  Calculation of constants as used in the OCMIP process for ICONST = 3 or 6
+!  see http://www.ipsl.jussieu.fr/OCMIP/
+!  added jcb 17/02/10
+
+!  Derive simple terms used more than once
+	dlogTK = log(TK)
+	S2 = S*S
+	sqrtS = sqrt(S)
+	S15 = S**1.5
+! k1 = [H][HCO3]/[H2CO3]
+! k2 = [H][CO3]/[HCO3]
+! Millero p.664 (1995) using Mehrbach et al. data on seawater scale 
+	k1=10**(-1*(3670.7/TK - 62.008 + 9.7944*dlogTK - &
+     &		0.0118 * S + 0.000116*S2))
+	k2=10**(-1*(1394.7/TK + 4.777 - &
+     &		0.0184*S + 0.000118*S2))
+! AXY (16/08/11): Yuri change for non-surface carbonate chemistry 
+! Correction for high pressure (from Millero 1995)
+! added YA 04/10/2010
+        delta=-25.5+0.1271*T
+        kappa=(-3.08+0.0877*T)/1000.0
+        k1=k1*exp((-delta+0.5*kappa*P)*P/(Rgas*TK))
+        delta=-15.82-0.0219*T
+        kappa=(1.13-0.1475*T)/1000.0
+        k2=k2*exp((-delta+0.5*kappa*P)*P/(Rgas*TK))
+
+! kb = [H][BO2]/[HBO2]
+! Millero p.669 (1995) using data from Dickson (1990)
+	kb=exp((-8966.90 - 2890.53*sqrtS - 77.942*S + &
+     &		1.728*S15 - 0.0996*S2)/TK + &
+     &		(148.0248 + 137.1942*sqrtS + 1.62142*S) + &
+     &		(-24.4344 - 25.085*sqrtS - 0.2474*S) * &
+     &		dlogTK + 0.053105*sqrtS*TK)
+! AXY (16/08/11): Yuri change for non-surface carbonate chemistry 
+! Correction for high pressure (from Millero, 1995)
+! added YA 04/10/2010
+        delta=-29.48+0.1622*T-0.002608*T**2.0
+        kappa=-2.84/1000.0
+        kb=kb*exp((-delta+0.5*kappa*P)*P/(Rgas*TK))
+! Correction for high pressure of Kw (from Millero 1995)
+! added YA 04/10/2010
+        delta=-25.60+0.2324*T-0.0036246*T**2
+        kappa=(-5.13+0.0794*T)/1000.0
+        AKVAL(1)=AKVAL(1)*exp((-delta+0.5*kappa*P)*P/(Rgas*TK))
+
+! replace haltafall calculations with OCMIP calculations
+      AKVAL(2) = k1
+      AKVAL(3) = k2
+      AKVAL(4) = kb
+      END IF ! section implimenting OCMIP coefficients
+
+      RETURN
+      END SUBROUTINE
+!-----------------------------------------------------------------------
+
+!=======================================================================
+!=======================================================================
+!=======================================================================
+
+!=======================================================================
+!
+      SUBROUTINE CO2CLC(CONCS,NCONC,AKVAL,NKVAL,ICALC,BORON,BTOT,iters)
+!      
+!=======================================================================
+! 
+! ROUTINE TO CARRY OUT CO2 CALCULATIONS WITH 2 FIXED PARAMETERS ACCORDI
+! THE EQUATIONS GIVEN BY PARKS(1969) AND SKIRROW (1975)
+! WITH ADDITIONS FOR INCLUDING BORON IF BORON=.TRUE.
+
+
+!      IMPLICIT real*8 (A-H,O-Z)
+      INTEGER             :: NCONC, NKVAL, ICALC, II, KARL, LQ, iters
+! AXY (07/05/13) ==================================================
+! put counter in to check duration in convergence loop
+      INTEGER             :: COUNTER,C_CHECK,C_SW,III
+! AXY (07/05/13) ==================================================
+      REAL(wp)            :: CTOT,ALK,PCO2,PH,H2CO3,HCO3,CO3,ALKC
+      REAL(wp)            :: ALKB,AKP,AK1C,AK2C,AKB,BTOT
+      REAL(wp)            :: AKR,AHPLUS
+      REAL(wp)            :: PROD,tol1,tol2,tol3,tol4,steg,fak
+      REAL(wp)            :: STEGBY,Y,X,W,X1,Y1,X2,Y2,FACTOR,TERM,Z
+      REAL(wp), DIMENSION(NCONC) :: CONCS
+      REAL(wp), DIMENSION(NKVAL) :: AKVAL
+      REAL(wp), DIMENSION(9)     :: CONCS2
+      REAL(wp), DIMENSION(4)     :: AKVAL2
+
+! AXY (07/05/13) ==================================================
+! setup array to store old values of concs
+      real(wp),DIMENSION(:) :: old_CONCS(NCONC)
+! AXY (07/05/13) ==================================================
+
+      EQUIVALENCE (CTOT  , CONCS2(1)), (ALK   , CONCS2(2)),  &
+     &            (PCO2  , CONCS2(3)), (PH    , CONCS2(4)),  &
+     &            (H2CO3 , CONCS2(5)), (HCO3  , CONCS2(6)),  &
+     &            (CO3   , CONCS2(7)), (ALKC  , CONCS2(8)),  &
+     &            (ALKB  , CONCS2(9)),                       &
+     &            (AKP   , AKVAL2(1)), (AK1C  , AKVAL2(2)),  &
+     &            (AK2C  , AKVAL2(3)), (AKB   , AKVAL2(4))
+      LOGICAL             :: BORON,DONE
+
+! AXY (07/05/13) ==================================================
+!  DERIVING PH REQUIRES FOLLOWING LOOP TO CONVERGE.
+!  THIS SUBROUTINE RELIES ON CONVERGENCE.  IF THE ENVIRONMENTAL
+!  CONDITIONS DO NOT ALLOW FOR CONVERGENCE (IN 3D MODEL THIS IS
+!  LIKELY TO OCCUR NEAR LOW SALINITY REGIONS) THE MODEL WILL 
+!  BE STUCK IN THE LOOP.  TO AVOID THIS A CONVERGENCE CONDITION
+!  IS PUT IN PLACE TO SET A FLAGG OF -99 IN THE PH VAR FOR NON CONVEGENCE. 
+!  THE MODEL IS THEN ALLOWED TO CONTINUE. 'COUNTER, C_SW,C_CHECK' ARE 
+!  THE LOCAL VARS USED.
+! C_SW = condition of convergence 0=yes, 1= no
+! COUNTER = number of iterations
+! C_CHECK = maximum number of iterations
+
+! SET COUNTER AND SWITCH TO ZERO AND OFF
+      COUNTER=0
+      C_SW=0
+! FROM EXPERIENCE IF THE ITERATIONS IN THE FOLLOWING DO LOOP
+! EXCEEDS 15 CONVERGENCE WILL NOT OCCUR.  THE OVERHEAD OF 25 ITERATIONS 
+! IS OK FOR SMALL DOMAINS WITH 1/10 AND 1/15 DEG RESOLUTION.
+! I RECOMMEND A LOWER VALUE OF 15 FOR HIGHER RESOLUTION OR LARGER DOMAINS.
+      C_CHECK=25
+! AXY (07/05/13) ==================================================
+
+      DO 100 II=1,NCONC
+        CONCS2(II)=CONCS(II)
+
+! AXY (07/05/13) ==================================================
+! IF CONVERGENCE IS NOT ACHIEVED THE LOCAL ARRAY CONCS MUST BE STORED TO 
+! ALLOW THE MODEL TO CONTINUE. THEREFORE ....
+! UPDATE OLD_CONCS
+        old_CONCS(II)=CONCS(II)
+! AXY (07/05/13) ==================================================
+
+100    CONTINUE
+      DO 110 II=1,NKVAL
+        AKVAL2(II)=AKVAL(II)
+110    CONTINUE
+      AKR = AK1C/AK2C
+      AHPLUS=10.0D0**(-PH)
+      PROD=AKR*AKP*PCO2
+     
+      IF(BORON) THEN
+
+        IF(ICALC.EQ.1.OR.ICALC.EQ.4) THEN
+!         *** ALK, BTOT AND CTOT OR PCO2 FIXED ***
+!         *** ITERATIVE CALCULATION NECESSARY HERE
+
+!         SET INITIAL GUESSES AND TOLERANCE
+          H2CO3=PCO2*AKP
+          CO3=ALK/10.0D0
+          AHPLUS=1.0D-8
+          ALKB=BTOT
+          TOL1=ALK/1.0D5
+          TOL2=H2CO3/1.0D5
+          TOL3=CTOT/1.0D5
+          TOL4=BTOT/1.0D5
+
+!         HALTAFALL iteration to determine CO3, ALKB, AHPLUS
+          KARL=1
+          STEG=2.0D0
+          FAK=1.0D0
+          STEGBY=0.4D0
+10        DONE=.TRUE.
+
+! AXY (07/05/13) ==================================================
+! SET COUNTER UPDATE. FLAG 10 IS THE POINT OF RETURN FOR 
+! THE CONVERGENCE CONDITION
+          COUNTER=COUNTER+1
+	  iters  = COUNTER
+! CHECK IF CONVERGENCE HAS OCCURED IN THE NUMBER OF 
+! ACCEPTABLE ITTERATIONS.  SET C_SW TO LET MODEL KNOW
+! WHAT TO DO AT THE END OF THE SUBROUTINE
+          if(counter.ge.c_check)then
+             IF(lwp) THEN
+                WRITE(numout,*) ' CO2CLC : ITERS WARNING, ', iters
+             ENDIF
+             c_sw=1
+             GOTO 123
+          endif
+! AXY (07/05/13) ==================================================
+
+          IF(ICALC.EQ.4) THEN
+!         *** PCO2 IS FIXED ***
+            Y=AHPLUS*AHPLUS*CO3/(AK1C*AK2C)
+            IF(ABS(Y-H2CO3).GT.TOL2) THEN
+              CO3=CO3*H2CO3/Y
+              DONE=.FALSE.
+            ENDIF
+          ELSEIF(ICALC.EQ.1) THEN
+!           *** CTOT IS FIXED ***
+            Y=CO3*(1.0D0+AHPLUS/AK2C+AHPLUS*AHPLUS/(AK1C*AK2C))
+            IF(ABS(Y-CTOT).GT.TOL3) THEN
+              CO3=CO3*CTOT/Y
+              DONE=.FALSE.
+            ENDIF
+          ENDIF
+          Y=ALKB*(1.0D0+AHPLUS/AKB)
+          IF(ABS(Y-BTOT).GT.TOL4) THEN
+            ALKB=ALKB*BTOT/Y
+            DONE=.FALSE.
+          ENDIF
+
+! Alkalinity is equivalent to -(total H+), so the sign of W is opposite
+! to that normally used
+
+          Y=CO3*(2.0D0+AHPLUS/AK2C)+ALKB
+          IF(ABS(Y-ALK).GT.TOL1) THEN
+            DONE=.FALSE.
+            X=LOG(AHPLUS)
+!           W=SIGN(1.0D0,Y-ALK)
+            IF ( Y-ALK .GE. 0.0D0 ) THEN
+            W=1.0D0
+            ELSE
+            W=-1.0D0
+            ENDIF
+            IF(W.GE.0.0D0) THEN
+              X1=X
+              Y1=Y
+            ELSE
+              X2=X
+              Y2=Y
+            ENDIF
+            LQ=KARL
+            IF(LQ.EQ.1) THEN
+              KARL=2*NINT(W)
+            ELSEIF(IABS(LQ).EQ.2.AND.(LQ*W).LT.0.) THEN
+              FAK=0.5D0
+              KARL=3
+            ENDIF
+            IF(KARL.EQ.3.AND.STEG.LT.STEGBY) THEN
+              W=(X2-X1)/(Y2-Y1)
+              X=X1+W*(ALK-Y1)
+            ELSE
+              STEG=STEG*FAK
+              X=X+STEG*W
+            ENDIF
+            AHPLUS=EXP(X)  
+          ENDIF
+          IF(.NOT.DONE) GOTO 10
+          
+          HCO3=CO3*AHPLUS/AK2C
+          IF(ICALC.EQ.4) THEN
+            CTOT=H2CO3+HCO3+CO3
+          ELSEIF(ICALC.EQ.1) THEN
+            H2CO3=HCO3*AHPLUS/AK1C
+            PCO2=H2CO3/AKP
+          ENDIF
+          PH=-LOG10(AHPLUS)
+          ALKC=ALK-ALKB
+        ELSEIF(ICALC.EQ.2) THEN
+!         *** CTOT, PCO2, AND BTOT FIXED ***
+          Y=SQRT(PROD*(PROD-4.0D0*AKP*PCO2+4.0D0*CTOT))
+          H2CO3=PCO2*AKP
+          HCO3=(Y-PROD)/2.0D0
+          CO3=CTOT-H2CO3-HCO3
+          ALKC=HCO3+2.0D0*CO3
+          AHPLUS=AK1C*H2CO3/HCO3
+          PH=-LOG10(AHPLUS)
+          ALKB=BTOT/(1.0D0+AHPLUS/AKB)
+          ALK=ALKC+ALKB
+        ELSEIF(ICALC.EQ.3) THEN
+!         *** CTOT, PH AND BTOT FIXED ***
+          FACTOR=CTOT/(AHPLUS*AHPLUS+AK1C*AHPLUS+AK1C*AK2C)
+          CO3=FACTOR*AK1C*AK2C
+          HCO3=FACTOR*AK1C*AHPLUS
+          H2CO3=FACTOR*AHPLUS*AHPLUS
+          PCO2=H2CO3/AKP
+          ALKC=HCO3+2.0D0*CO3
+          ALKB=BTOT/(1.0D0+AHPLUS/AKB)
+          ALK=ALKC+ALKB
+        ELSEIF(ICALC.EQ.5) THEN
+!         *** ALK, PH AND BTOT FIXED ***
+          ALKB=BTOT/(1.0D0+AHPLUS/AKB)
+          ALKC=ALK-ALKB
+          HCO3=ALKC/(1.0D0+2.0D0*AK2C/AHPLUS)
+          CO3=HCO3*AK2C/AHPLUS
+          H2CO3=HCO3*AHPLUS/AK1C
+          PCO2=H2CO3/AKP
+          CTOT=H2CO3+HCO3+CO3
+        ELSEIF(ICALC.EQ.6) THEN
+!         *** PCO2, PH AND BTOT FIXED ***
+          ALKB=BTOT/(1.0D0+AHPLUS/AKB)
+          H2CO3=PCO2*AKP
+          HCO3=H2CO3*AK1C/AHPLUS
+          CO3=HCO3*AK2C/AHPLUS
+          CTOT=H2CO3+HCO3+CO3
+          ALKC=HCO3+2.0D0*CO3
+          ALK=ALKC+ALKB
+        ENDIF
+      ELSE
+        IF(ICALC.EQ.1) THEN
+!         *** CTOT AND ALK FIXED ***
+          TERM=4.0D0*ALK+CTOT*AKR-ALK*AKR
+          Z=SQRT(TERM*TERM+4.0D0*(AKR-4.0D0)*ALK*ALK)
+          CO3=(ALK*AKR-CTOT*AKR-4.0D0*ALK+Z)/(2.0D0*(AKR-4.0D0))
+          HCO3=(CTOT*AKR-Z)/(AKR-4.0D0)
+          H2CO3=CTOT-ALK+CO3
+          PCO2=H2CO3/AKP
+          PH=-LOG10(AK1C*H2CO3/HCO3)
+        ELSEIF(ICALC.EQ.2) THEN
+!         *** CTOT AND PCO2 FIXED ***
+          Y=SQRT(PROD*(PROD-4.0D0*AKP*PCO2+4.0D0*CTOT))
+          H2CO3=PCO2*AKP
+          HCO3=(Y-PROD)/2.0D0
+          CO3=CTOT-H2CO3-HCO3
+          ALK=HCO3+2.0D0*CO3
+          PH=-LOG10(AK1C*H2CO3/HCO3)
+        ELSEIF(ICALC.EQ.3) THEN
+!         *** CTOT AND PH FIXED ***
+          FACTOR=CTOT/(AHPLUS*AHPLUS+AK1C*AHPLUS+AK1C*AK2C)
+          CO3=FACTOR*AK1C*AK2C
+          HCO3=FACTOR*AK1C*AHPLUS
+          H2CO3=FACTOR*AHPLUS*AHPLUS
+          PCO2=H2CO3/AKP
+          ALK=HCO3+2.0D0*CO3
+        ELSEIF(ICALC.EQ.4) THEN
+!         *** ALK AND PCO2 FIXED ***
+          TERM=SQRT((8.0D0*ALK+PROD)*PROD)
+          CO3=ALK/2.0D0+PROD/8.0D0-TERM/8.0D0
+          HCO3=-PROD/4.0D0+TERM/4.0D0
+          H2CO3=PCO2*AKP
+          CTOT=CO3+HCO3+H2CO3
+          PH=-LOG10(AK1C*H2CO3/HCO3)
+        ELSEIF(ICALC.EQ.5) THEN
+!         *** ALK AND PH FIXED ***
+          HCO3=ALK/(1.0D0+2.0D0*AK2C/AHPLUS)
+          CO3=HCO3*AK2C/AHPLUS
+          H2CO3=HCO3*AHPLUS/AK1C
+          PCO2=H2CO3/AKP
+          CTOT=H2CO3+HCO3+CO3
+        ELSEIF(ICALC.EQ.6) THEN
+!         *** PCO2 AND PH FIXED ***
+          H2CO3=PCO2*AKP
+          HCO3=H2CO3*AK1C/AHPLUS
+          CO3=HCO3*AK2C/AHPLUS
+          CTOT=H2CO3+HCO3+CO3
+          ALK=HCO3+2.0D0*CO3
+        ENDIF
+      ENDIF
+
+      DO 120 II=1,NCONC
+        CONCS(II)=CONCS2(II)
+120    CONTINUE
+
+! AXY (07/05/13) ==================================================
+! C_SW IS SET AT 0 TO START
+! THEN IF NON CONVERGENCE C_SW SET TO 1
+123   IF(C_SW.EQ.1)THEN
+! IF NON CONVERGENCE, THE MODEL REQUIRES CONCS TO CONTAIN USABLE VALUES.
+! BEST OFFER BEING THE OLD CONCS VALUES WHEN CONVERGENCE HAS BEEN 
+! ACHIEVED
+        DO II=1,NCONC
+           CONCS(II)=OLD_CONCS(II)
+        END DO
+
+! SPECIFIC CARBONATE VALUES TO PUSH CODE ON THROUGH THE
+! NON CONVERGENCE CONDITIONS
+! PCO2W = 0 SO CO2 UPTAKE WILL BE ENCOURAGED
+!       CONCS(3)=O3C(III)*0.005_fp8/1.e6_fp8
+! -99 IS A FLAG TO SHOW WHEN AND WHERE NON CONVERGENCE OCCURED
+! CONCS(4)=PH, OUTPUT OF -99 MEANS NON-CONVERGENCE
+!       CONCS(4)=-99._fp8
+! 
+! AXY (10/05/13): remove this -99 flag; this is handled instead up in
+!                 trcbio_medusa.F90 where the iters variable is both 
+!                 output and may be used to trigger action
+!
+! RESET SWITCH FOR NEXT CALL TO THIS SUBROUTINE
+        C_SW=0
+      ENDIF
+! AXY (07/05/13) ==================================================
+
+
+      RETURN
+
+      END SUBROUTINE
+!-----------------------------------------------------------------------
+
+!=======================================================================
+!=======================================================================
+!=======================================================================
+
+!=======================================================================
+!
+      SUBROUTINE CaCO3_Saturation (Tc, S, D, CO3, &
+      Om_cal, Om_arg)
+!      
+!=======================================================================
+!
+! Routine to calculate the saturation state of calcite and aragonite    
+! Inputs:                                                               
+!               Tc      Temperature (C)                                 
+!               S       Salinity                                        
+!               D       Depth (m)                                       
+!               CO3     Carbonate ion concentration (mol.kg-1 ie /1D6)
+!                                                                       
+! Outputs                                                               
+!               Om_cal  Calite saturation                               
+!               Om_arg  Aragonite saturation                            
+!                                                                       
+! Intermediates                                                         
+!               K_cal   Stoichiometric solubility product for calcite   
+!               K_arg   Stoichiometric solubility product for aragonite 
+!               Ca      Calcium 2+ concentration (mol.kg-1) 
+!               P       Pressure (bars)
+!                                                                       
+! Source                                                                
+!       Zeebe & Wolf-Gladrow 2001 following Mucci (1983)                
+!       with pressure corrections from Millero (1995)                   
+!       Code tested against reference values given in Z & W-G
+!       Built Jerry Blackford, 2008
+!=======================================================================
+
+        IMPLICIT None
+        REAL(wp), INTENT( in )    :: Tc, S, D, CO3
+        REAL(wp), INTENT( inout ) :: Om_cal, Om_arg
+        REAL(wp) :: Tk, Kelvin, Ca
+        REAL(wp) :: logKspc, Kspc
+        REAL(wp) :: logKspa, Kspa
+        REAL(wp) :: tmp1, tmp2, tmp3
+        REAL(wp) :: dV, dK, P, R
+               
+! setup
+        Kelvin = 273.15
+        Tk = Tc + Kelvin 
+        Ca = 0.01028    ! Currently oceanic mean value at S=25, needs refining)
+        Ca = 0.010279 * (S / 35.0)  ! Ca varies with salinity (cf. Feeley et al., 2004; Yool et al., 2010)
+        R = 83.131      !(cm3.bar.mol-1.K-1)
+        P = D / 10.0    !pressure in bars
+
+! calculate K for calcite
+        tmp1 = -171.9065 - (0.077993*Tk) + (2839.319/Tk) + 71.595*log10(Tk) 
+        tmp2 = + (-0.77712 + (0.0028426*Tk) + (178.34/Tk))*SQRT(S) 
+        tmp3 = - (0.07711*S) + (0.0041249*(S**1.5))
+        logKspc = tmp1 + tmp2 + tmp3
+        Kspc = 10.0**logKspc
+      
+! correction for pressure for calcite
+        IF ( D .GT. 0) THEN
+          dV = -48.76 + 0.5304*Tc
+          dK = -11.76/1.0D3 + (0.3692/1.0D3) * Tc
+          tmp1 = -(dV/(R*Tk))*P + (0.5*dK/(R*Tk))*P*P
+          Kspc = Kspc*exp(tmp1)
+          logKspc = log10(Kspc)
+        END IF
+        
+! calculate K for aragonite
+        tmp1 = -171.945 - 0.077993*Tk + 2903.293 / Tk + 71.595* log10(Tk)
+        tmp2 = + (-0.068393 + 0.0017276*Tk + 88.135/Tk)*SQRT(S)    
+        tmp3 = - 0.10018*S + 0.0059415*S**1.5
+        logKspa = tmp1 + tmp2 + tmp3
+        Kspa = 10.0**logKspa
+     
+! correction for pressure for aragonite
+        IF ( D .GT. 0) THEN
+          dV = -46.00 + 0.5304*Tc
+          dK = -11.76/1.0D3 + (0.3692/1.0D3) * Tc
+          tmp1 = -(dV/(R*Tk))*P + (0.5*dK/(R*Tk))*P*P
+          Kspa = Kspa*exp(tmp1)
+          logKspa = log10(Kspa)
+        END IF
+        
+! calculate saturation states
+        Om_cal = (CO3 * Ca) / Kspc
+        Om_arg = (CO3 * Ca) / Kspa
+      
+      RETURN
+
+      END SUBROUTINE
+!-----------------------------------------------------------------------
+
+!=======================================================================
+!=======================================================================
+!=======================================================================
+
+#  else
+   !!======================================================================
+   !!  Dummy module :                         No MEDUSA carbonate chemistry
+   !!======================================================================
+
+CONTAINS
+
+   SUBROUTINE trc_co2_medusa( kt )                   ! Empty routine
+
+      INTEGER, INTENT( in ) ::   kt
+
+      WRITE(*,*) 'trc_co2_medusa: You should not have seen this print! error?', kt
+
+   END SUBROUTINE trc_co2_medusa
+#endif 
+
+   !!======================================================================
+END MODULE  trcco2_medusa
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcctl_medusa.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcctl_medusa.F90	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcctl_medusa.F90	(revision 8201)
@@ -0,0 +1,83 @@
+MODULE trcctl_medusa
+   !!======================================================================
+   !!                         ***  trcctl_medusa.F90  ***
+   !! TOP :                Control of MEDUSA_TRC biogeochemical model
+   !!======================================================================
+   !!----------------------------------------------------------------------
+   !! History :   1.0  !  2000-12 (C. Ethe) assign a parameter to name individual tracers
+   !!              -   !  2008-08  (K. Popova) adaptation for MEDUSA
+   !!              -   !  2008-11  (A. Yool) continuing adaptation for MEDUSA
+   !!              -   !  2010-03  (A. Yool) updated for branch inclusion
+   !!----------------------------------------------------------------------
+
+#if defined key_medusa
+
+   USE oce_trc
+   USE trc
+   USE in_out_manager
+   USE par_medusa
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC trc_ctl_medusa     ! called by ???
+
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_ctl_medusa
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_ctl_medusa  ***
+      !!
+      !! ** Purpose :   control the cpp options, namelist and files 
+      !!----------------------------------------------------------------------
+
+!      IF(lwp) WRITE(numout,*)
+!      IF(lwp) WRITE(numout,*) 'use MEDUSA biological model  '
+
+! Check number of tracers
+! -----------------------
+# if defined key_roam
+      IF (jp_medusa /= 15) THEN 
+          IF (lwp) THEN 
+              WRITE (numout,*) ' ===>>>> : W A R N I N G '
+              WRITE (numout,*) ' =======   ============= '
+              WRITE (numout,*)                             &
+              &   ' STOP, change jp_medusa to 15 in '      &
+              &  ,' par_medusa.F90 '  
+          END IF 
+          STOP 'TRC_CTL'
+      END IF 
+# else
+      IF (jp_medusa /= 11) THEN 
+          IF (lwp) THEN 
+              WRITE (numout,*) ' ===>>>> : W A R N I N G '
+              WRITE (numout,*) ' =======   ============= '
+              WRITE (numout,*)                             &
+              &   ' STOP, change jp_medusa to 11 in '      &
+              &  ,' par_medusa.F90 '  
+          END IF 
+          STOP 'TRC_CTL'
+      END IF 
+# endif
+
+   END SUBROUTINE trc_ctl_medusa
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Empty module :                                            No MEDUSA
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_ctl_medusa               ! Dummy routine
+   END SUBROUTINE trc_ctl_medusa
+#endif
+
+   !!======================================================================
+END MODULE trcctl_medusa
+      
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcdms_medusa.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcdms_medusa.F90	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcdms_medusa.F90	(revision 8201)
@@ -0,0 +1,201 @@
+MODULE trcdms_medusa
+   !!======================================================================
+   !!                         ***  MODULE trcdms_medusa  ***
+   !! TOP :   MEDUSA
+   !!======================================================================
+   !! History :
+   !!  -   !  2014-08  (J. Palmieri - A. Yool)    added for UKESM1 project
+   !!  -   !  2017-05  (A. Yool)                  add extra Anderson scheme
+   !!----------------------------------------------------------------------
+#if defined key_medusa && defined key_roam
+   !!----------------------------------------------------------------------
+   !!                                        MEDUSA DMS surface concentration
+   !!----------------------------------------------------------------------
+   !!   trc_dms_medusa        :  
+   !!----------------------------------------------------------------------
+      USE oce_trc
+      USE trc
+      USE sms_medusa
+      USE lbclnk
+      USE prtctl_trc      ! Print control for debugging
+      USE in_out_manager  ! I/O manager
+
+      IMPLICIT NONE
+      PRIVATE
+
+      PUBLIC   trc_dms_medusa    ! called in trc_bio_medusa
+
+   !!* Substitution
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+
+CONTAINS
+
+!=======================================================================
+!
+   SUBROUTINE trc_dms_medusa( chn, chd, mld, xqsr, xdin, xlim,  &  !! inputs
+     &  dms_andr, dms_simo, dms_aran, dms_hall, dms_andm)           !! outputs
+!      
+!=======================================================================
+      !!
+      !! Title  : Calculates DMS ocean surface concentration
+      !! Author : Julien Palmieri and Andrew Yool
+      !! Date   : 08/08/14 
+      !!
+      !! DMS module is called in trc_bio's huge jk,jj,ji loop
+      !! --> DMS concentration is calculated in a specific cell 
+      !! (no need of ji,jj,jk)
+      !!
+      !! AXY (13/03/15): amend to include all four schemes tested
+      !!                 during winter/spring 2015; these are:
+      !!
+      !!                 1. Anderson et al. (2001); this uses fields
+      !!                    of surface chl, irradiance and nutrients
+      !!                    to empirically estimate DMS via a broken
+      !!                    stick approach
+      !!
+      !!                 2. Simo & Dachs (2002); this uses fields of
+      !!                    surface chl and mixed layer depth
+      !!
+      !!                 3. Aranami & Tsunogai (2004); this is an
+      !!                    embellishment of Simo & Dachs
+      !!
+      !!                 4. Halloran et al. (2010); this is an
+      !!                    alternative embellishment of Sim & Dachs
+      !!                    and is included because it is formally
+      !!                    published (and different from the above)
+      !!
+      !! AXY (25/05/17): add extra "corrected" Anderson scheme
+      !!
+      !!                 5. As Anderson et al. (2001) but modified to
+      !!                    more accurately reflect nutrient limitation
+      !!                    status of phytoplankton community
+      !!
+      !! AXY (08/07/15): amend to remove Julien's original calculation
+      !!                 as this is now superfluous; the four schemes 
+      !!                 are calculated and one is chosen to be passed
+      !!                 to the atmosphere in trc_bio_medusa
+      !!
+!=======================================================================
+
+      IMPLICIT NONE
+!
+      REAL(wp), INTENT( in )    :: chn                  !! non-diatom chlorophyll    (mg/m3)
+      REAL(wp), INTENT( in )    :: chd                  !! diatom chlorophyll        (mg/m3)
+      REAL(wp), INTENT( in )    :: mld                  !! mix layer depth           (m)
+      REAL(wp), INTENT( in )    :: xqsr                 !! surface irradiance        (W/m2)
+      REAL(wp), INTENT( in )    :: xdin                 !! surface DIN               (mmol N/m3)
+      REAL(wp), INTENT( in )    :: xlim                 !! surface DIN limitation    (mmol N/m3)
+      REAL(wp), INTENT( inout ) :: dms_andr             !! DMS surface concentration (nmol/L) 
+      REAL(wp), INTENT( inout ) :: dms_simo             !! DMS surface concentration (nmol/L) 
+      REAL(wp), INTENT( inout ) :: dms_aran             !! DMS surface concentration (nmol/L) 
+      REAL(wp), INTENT( inout ) :: dms_hall             !! DMS surface concentration (nmol/L) 
+      REAL(wp), INTENT( inout ) :: dms_andm             !! DMS surface concentration (nmol/L) 
+!
+      REAL(wp) :: CHL, cmr, sw_dms
+      REAL(wp) :: Jterm, Qterm
+      !! temporary variables
+      REAL(wp) ::    fq1,fq2,fq3
+! 
+!=======================================================================
+!
+! AXY (13/03/15): per remarks above, the following calculations estimate
+!                 DMS using all of the schemes examined for UKESM1
+!
+      CHL = 0.0
+      CHL = chn+chd                                 !! mg/m3 
+      cmr = CHL / mld
+!
+! AXY (13/03/15): Anderson et al. (2001)
+        Jterm = xqsr + 1.0e-6
+        !! this next line makes a hard-coded assumption about the 
+        !! half-saturation constant of MEDUSA (which should be
+        !! done properly; perhaps even scaled with the proportion
+        !! of diatoms and non-diatoms)
+        Qterm = xdin / (xdin + 0.5)
+        fq1 = log10(CHL * Jterm * Qterm)
+        if (fq1 > 1.72) then
+           dms_andr = (8.24 * (fq1 - 1.72)) + 2.29
+        else
+           dms_andr = 2.29
+        endif
+!
+! AXY (13/03/15): Simo & Dachs (2002)
+        fq1 = (-1.0 * log(mld)) + 5.7
+        fq2 = (55.8 * cmr) + 0.6
+        if (cmr < 0.02) then
+           dms_simo = fq1
+        else
+           dms_simo = fq2
+        endif
+!           
+! AXY (13/03/15): Aranami & Tsunogai (2004)
+        fq1 = 60.0 / mld
+        fq2 = (55.8 * cmr) + 0.6
+        if (cmr < 0.02) then
+           dms_aran = fq1
+        else
+           dms_aran = fq2
+        endif
+!        
+! AXY (13/03/15): Halloran et al. (2010)
+        fq1 = (-1.0 * log(mld)) + 5.7
+        fq2 = (55.8 * cmr) + 0.6
+        fq3 = (90.0 / mld)
+        if (cmr < 0.02) then
+           dms_hall = fq1
+        else
+           dms_hall = fq2
+        endif
+        if (mld > 182.5) then
+           dms_hall = fq3
+        endif
+!
+! AXY (25/05/17): modified Anderson et al. (2001)
+        Jterm = xqsr + 1.0e-6
+        !! this version fixes the hard-coded assumption above
+        Qterm = xlim
+        fq1 = log10(CHL * Jterm * Qterm)
+        if (fq1 > 1.72) then
+           dms_andm = (8.24 * (fq1 - 1.72)) + 2.29
+        else
+           dms_andm = 2.29
+        endif
+
+  END SUBROUTINE trc_dms_medusa
+
+
+!=======================================================================
+!=======================================================================
+!=======================================================================
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No MEDUSA bio-model
+   !!======================================================================
+
+CONTAINS
+
+!=======================================================================
+!
+   SUBROUTINE trc_dms_medusa( kt )                                        !! EMPTY Routine
+!      
+!
+      INTEGER, INTENT( in ) ::   kt
+!
+
+      WRITE(*,*) 'trc_dms_medusa: You should not have seen this print! error?'
+
+   END SUBROUTINE trc_dms_medusa
+#endif
+
+   !!======================================================================
+END MODULE  trcdms_medusa
+
+
+
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcini_medusa.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcini_medusa.F90	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcini_medusa.F90	(revision 8201)
@@ -0,0 +1,492 @@
+MODULE trcini_medusa
+   !!======================================================================
+   !!                         ***  MODULE trcini_medusa  ***
+   !! TOP :   initialisation of the MEDUSA tracers
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code
+   !!              -   !  2008-08  (K. Popova) adaptation for MEDUSA
+   !!              -   !  2008-11  (A. Yool) continuing adaptation for MEDUSA
+   !!              -   !  2010-03  (A. Yool) updated for branch inclusion
+   !!              -   !  2011-04  (A. Yool) updated for ROAM project
+   !!----------------------------------------------------------------------
+#if defined key_medusa
+   !!----------------------------------------------------------------------
+   !!   'key_medusa'                                         MEDUSA tracers
+   !!----------------------------------------------------------------------
+   !! trc_ini_medusa   : MEDUSA model initialisation
+   !!----------------------------------------------------------------------
+   USE par_trc         ! TOP parameters
+   USE oce_trc
+   USE trc
+   USE in_out_manager
+   !! AXY (04/11/13): add this in for initialisation stuff
+   USE iom
+   USE par_medusa
+   !! AXY (13/01/12): add this in for sediment variables
+   USE sms_medusa
+   !! AXY (04/11/13): add this in for initialisation stuff
+   USE trcsed_medusa
+   USE sbc_oce, ONLY: lk_oasis
+   USE oce,     ONLY: CO2Flux_out_cpl, DMS_out_cpl, chloro_out_cpl  !! Coupling variable
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_ini_medusa   ! called by trcini.F90 module
+
+   !! AXY (25/02/10)
+   LOGICAL, PUBLIC ::                  &
+      bocalccd = .TRUE.
+   !! JPALM (14/09/15)
+   LOGICAL, PUBLIC ::                  &
+      ln_ccd = .TRUE.
+
+   INTEGER ::                          &
+      numccd
+
+   !! AXY (25/02/10)
+   INTEGER ::                          &
+      numriv
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_ini_medusa
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_ini_medusa  ***  
+      !!
+      !! ** Purpose :   initialization for MEDUSA model
+      !!
+      !! ** Method  : - Read the namcfc namelist and check the parameter values
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+
+      !! vertical array index
+      INTEGER  ::    jk, ierr
+      !! AXY (19/07/12): added jk2 to set up friver_dep array
+      INTEGER            :: jk2
+      !! AXY (19/07/12): added tfthk to set up friver_dep array
+      REAL(wp)           :: fthk, tfthk
+      !! AXY (04/11/13): add in temporary variables for checks
+      REAL(wp)           :: fq0, fq1, fq2
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: initialisation of MEDUSA model'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+# if defined key_debug_medusa
+            CALL flush(numout)
+# endif
+
+                                           ! Allocate MEDUSA arrays
+      ierr =         sms_medusa_alloc()
+# if defined key_debug_medusa
+            IF (lwp) write (numout,*) '------------------------------'
+            IF (lwp) write (numout,*) 'Jpalm - debug'
+            IF (lwp) write (numout,*) 'in trc_ini_medusa, just after array allocate'
+            IF (lwp) write (numout,*) ' '
+            CALL flush(numout)
+# endif
+
+!!
+!! AXY (19/07/12): setup array to control distribution of river nutrients
+      friver_dep(:,:) = 0.
+      DO jk = 1,jpk
+         tfthk = 0.
+         DO jk2 = 1,jriver_dep
+            fthk  = e3t_1d(jk2)
+            if (jk2 .le. jk) then
+               tfthk = tfthk + fthk
+               friver_dep(jk2,jk) = fthk
+            endif
+         ENDDO
+         DO jk2 = 1,jriver_dep
+            friver_dep(jk2,jk) = friver_dep(jk2,jk) / tfthk
+         ENDDO
+      ENDDO
+!!
+!! Have a look at the result of this for a single depth (jriver_dep + 1)
+      IF(lwp) THEN
+          WRITE(numout,*) '=== River nutrient fraction by depth (for a water column of jpk depth)'
+          DO jk = 1,jpk
+             WRITE(numout,*)     &
+             &   ' cell = ', jk, ', friver_dep value = ', friver_dep(jk,jpk)
+          ENDDO
+          IF(lwp) CALL flush(numout)
+       ENDIF
+
+#if defined key_roam
+!! ROAM 3D and 2D carbonate system fields (calculated on first time
+!! step, then monthly)
+      f3_pH(:,:,:)    = 0.
+      f3_h2co3(:,:,:) = 0.
+      f3_hco3(:,:,:)  = 0.
+      f3_co3(:,:,:)   = 0.
+      f3_omcal(:,:,:) = 0.
+      f3_omarg(:,:,:) = 0.
+!!
+      f2_ccd_cal(:,:) = 0.
+      f2_ccd_arg(:,:) = 0.
+      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: carbonate fields initialised to zero'
+#endif
+      IF(lwp) CALL flush(numout)
+
+      !!----------------------------------------------------------------------
+      !! State variable initial conditions (all mmol / m3)
+      !!----------------------------------------------------------------------
+      !!     
+      !! biological and detrital components are initialised to nominal
+      !! values above 100 m depth and zero below; the latter condition
+      !! is applied since non-linear loss processes allow significant
+      !! concentrations of these components to persist at depth
+      !!
+      trn(:,:,:,jpchn) = 0.
+      trn(:,:,:,jpchd) = 0.
+      trn(:,:,:,jpphn) = 0.
+      trn(:,:,:,jpphd) = 0.
+      trn(:,:,:,jppds) = 0.
+      trn(:,:,:,jpzmi) = 0.
+      trn(:,:,:,jpzme) = 0.
+      trn(:,:,:,jpdet) = 0.
+      !!
+      DO jk = 1,13
+         !! non-diatom chlorophyll         (nominal)
+         trn(:,:,jk,jpchn) = 0.01
+         !!
+         !! diatom chlorophyll             (nominal)
+         trn(:,:,jk,jpchd) = 0.01
+         !!
+         !! non-diatom                     (nominal)
+         trn(:,:,jk,jpphn) = 0.01
+         !!
+         !! diatom                         (nominal)
+         trn(:,:,jk,jpphd) = 0.01
+         !!
+         !! diatom silicon                 (nominal)
+         trn(:,:,jk,jppds) = 0.01
+         !!
+         !! microzooplankton               (nominal)
+         trn(:,:,jk,jpzmi) = 0.01
+         !!
+         !! mesozooplankton                (nominal)
+         trn(:,:,jk,jpzme) = 0.01
+         !!
+         !! detrital nitrogen              (nominal)
+         trn(:,:,jk,jpdet) = 0.01
+      ENDDO
+      !!
+      !! dissolved inorganic nitrogen     (nominal average value; typically initialised from climatology)
+      trn(:,:,:,jpdin) = 30.
+      !!
+      !! dissolved silicic acid           (nominal average value; typically initialised from climatology)
+      trn(:,:,:,jpsil) = 90.
+      !!
+      !! dissolved "total" iron           (nominal; typically initialised from model-derived climatology)
+      trn(:,:,:,jpfer) = 1.0e-4           !! = 0.1 umol Fe / m3
+      !!
+      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: MEDUSA-1 fields initialised to defaults'
+# if defined key_roam
+      !!
+      !! detrital carbon                  (nominal)
+      trn(:,:,:,jpdtc) = 0.
+      DO jk = 1,13
+         trn(:,:,jk,jpdtc) = 0.06625
+      ENDDO
+      !!
+      !! dissolved inorganic carbon (DIC) (nominal average value; typically initialised from climatology)
+      trn(:,:,:,jpdic) = 2330.
+      !!
+      !! total alkalinity                 (nominal average value; typically initialised from climatology)
+      trn(:,:,:,jpalk) = 2450.
+      !!
+      !! dissolved oxygen                 (nominal average value; typically initialised from climatology)
+      trn(:,:,:,jpoxy) = 175.
+      !!
+      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: MEDUSA-2 fields initialised to defaults'
+# endif
+      IF(lwp) CALL flush(numout)
+
+      !!----------------------------------------------------------------------
+      !! Sediment pools initial conditions (all mmol / m2)
+      !!----------------------------------------------------------------------
+      !!     
+      !! these pools store biogenic material that has sunk to the seabed,
+      !! and act as a temporary reservoir
+      zb_sed_n(:,:)  = 0.0  !! organic N
+      zn_sed_n(:,:)  = 0.0
+      za_sed_n(:,:)  = 0.0
+      zb_sed_fe(:,:) = 0.0  !! organic Fe
+      zn_sed_fe(:,:) = 0.0
+      za_sed_fe(:,:) = 0.0
+      zb_sed_si(:,:) = 0.0  !! inorganic Si
+      zn_sed_si(:,:) = 0.0
+      za_sed_si(:,:) = 0.0
+      zb_sed_c(:,:)  = 0.0  !! organic C
+      zn_sed_c(:,:)  = 0.0
+      za_sed_c(:,:)  = 0.0
+      zb_sed_ca(:,:) = 0.0  !! inorganic C
+      zn_sed_ca(:,:) = 0.0
+      za_sed_ca(:,:) = 0.0
+      !!
+      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: benthic fields initialised to zero'
+      IF(lwp) CALL flush(numout)
+     
+      !!----------------------------------------------------------------------
+      !! Averaged properties for DMS calculations (various units)
+      !!----------------------------------------------------------------------
+      !!     
+      !! these store temporally averaged properties for DMS calculations (AXY, 07/07/15)
+      zb_dms_chn(:,:)  = 0.0  !! CHN
+      zn_dms_chn(:,:)  = 0.0
+      za_dms_chn(:,:)  = 0.0
+      zb_dms_chd(:,:)  = 0.0  !! CHD
+      zn_dms_chd(:,:)  = 0.0
+      za_dms_chd(:,:)  = 0.0
+      zb_dms_mld(:,:)  = 0.0  !! MLD
+      zn_dms_mld(:,:)  = 0.0
+      za_dms_mld(:,:)  = 0.0
+      zb_dms_qsr(:,:)  = 0.0  !! QSR
+      zn_dms_qsr(:,:)  = 0.0
+      za_dms_qsr(:,:)  = 0.0
+      zb_dms_din(:,:)  = 0.0  !! DIN
+      zn_dms_din(:,:)  = 0.0
+      za_dms_din(:,:)  = 0.0
+      !!
+      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: average fields for DMS initialised to zero'
+      IF(lwp) CALL flush(numout)
+      !!
+      !!---------------------------------------------------------------------
+      !!JPALM (14-06-2016): init dms and co2 flux for coupling with atm (UKESM)
+      !!---------------------------------------------------------------------
+      !!
+      zb_co2_flx(:,:)  = 0.0  !! CO2 flx
+      zn_co2_flx(:,:)  = 0.0
+      za_co2_flx(:,:)  = 0.0
+      zb_dms_srf(:,:)  = 0.0  !! DMS srf
+      zn_dms_srf(:,:)  = 0.0
+      za_dms_srf(:,:)  = 0.0
+      zn_chl_srf(:,:)  = 2.0E-8 !! Chl srf
+      !!
+      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: DMS and CO2 flux (UKESM) initialised to zero'
+      IF(lwp) CALL flush(numout)
+      IF (lk_oasis) THEN
+         CO2Flux_out_cpl(:,:) =  zn_co2_flx(:,:)   !! Coupling variable
+         DMS_out_cpl(:,:)     =  zn_dms_srf(:,:)   !! Coupling variable
+         chloro_out_cpl(:,:)  =  zn_chl_srf(:,:)   !! Coupling variable
+      END IF
+      !!
+      !!----------------------------------------------------------------------
+      !! AXY (04/11/13): initialise fields previously done by trc_sed_medusa
+      !!----------------------------------------------------------------------
+      !!     
+      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: initialising dust deposition fields'
+      CALL trc_sed_medusa_sbc( nit000 )
+      !!
+      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: initialising ocean CCD array'
+      CALL trc_ini_medusa_ccd( nit000 )
+      fq0 = MINVAL(ocal_ccd(:,:))
+      fq1 = MAXVAL(ocal_ccd(:,:))
+      if (lwp) write (numout,'(a,f10.3,a,f10.3)') & 
+         & 'CCD: min ', fq0, ' max ', fq1
+      !!
+      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: initialising riverine nutrient arrays'
+      riv_n(:,:)   = 0.0
+      riv_si(:,:)  = 0.0
+      riv_c(:,:)   = 0.0
+      riv_alk(:,:) = 0.0 
+      !!
+      CALL trc_ini_medusa_river( nit000 )
+      fq0 = MINVAL(riv_n(:,:))
+      fq1 = MAXVAL(riv_n(:,:))
+      if (lwp) write (numout,'(a,f10.3,a,f10.3)') & 
+         & 'RIV_N:   min ', fq0, ' max ', fq1
+      fq0 = MINVAL(riv_si(:,:))
+      fq1 = MAXVAL(riv_si(:,:))
+      if (lwp) write (numout,'(a,f10.3,a,f10.3)') & 
+         & 'RIV_SI:  min ', fq0, ' max ', fq1
+      fq0 = MINVAL(riv_c(:,:))
+      fq1 = MAXVAL(riv_c(:,:))
+      if (lwp) write (numout,'(a,f10.3,a,f10.3)') & 
+         & 'RIV_C:   min ', fq0, ' max ', fq1
+      fq0 = MINVAL(riv_alk(:,:))
+      fq1 = MAXVAL(riv_alk(:,:))
+      if (lwp) write (numout,'(a,f10.3,a,f10.3)') & 
+         & 'RIV_ALK: min ', fq0, ' max ', fq1
+      IF(lwp) CALL flush(numout)
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: MEDUSA initialised'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+      IF(lwp) CALL flush(numout)
+
+   END SUBROUTINE trc_ini_medusa
+
+   !! ======================================================================
+   !! ======================================================================
+   !! ======================================================================
+
+   !! AXY (25/02/10)
+   SUBROUTINE trc_ini_medusa_ccd(kt)
+
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_ini_medusa_ccd  ***
+      !!
+      !! ** Purpose :   Read CCD field
+      !!
+      !! ** Method  :   Read the file
+      !!
+      !! ** input   :   external netcdf files
+      !!
+      !!----------------------------------------------------------------------
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+
+      !!---------------------------------------------------------------------
+
+      !! Open the file
+      !! -------------
+      !!
+      !!!! JPALM -- 14-09-2015 -- 
+      !!!!       -- to test on ORCA2 with Christian, no file available, so initiate to 0 
+      IF (ln_ccd) THEN
+         IF(lwp) WRITE(numout,*) ' '
+         IF(lwp) WRITE(numout,*) ' **** Routine trc_ini_medusa_ccd'
+         CALL iom_open ( 'ccd_ocal_nemo.nc', numccd )
+         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_ccd: ccd_ocal_nemo.nc opened'
+
+      !! Read the data
+      !! -------------
+      !!
+         CALL iom_get ( numccd, jpdom_data, 'OCAL_CCD', ocal_ccd )
+         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_ccd: data read'
+
+      !! Close the file
+      !! --------------
+      !!
+         CALL iom_close ( numccd )
+         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_ccd: ccd_ocal_nemo.nc closed'
+         IF(lwp) CALL flush(numout)
+      ELSE
+         IF(lwp) WRITE(numout,*) ' '
+         IF(lwp) WRITE(numout,*) ' **** Routine trc_ini_medusa_ccd'
+         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_ccd: do not read ccd_ocal_nemo.nc'
+         IF(lwp) WRITE(numout,*) ' **** ln_ccd = FALSE and ocal_ccd = 0.0 ---'
+         ocal_ccd(:,:) = 0.0  
+      ENDIF
+ 
+   END SUBROUTINE trc_ini_medusa_ccd
+
+   !! ======================================================================
+   !! ======================================================================
+   !! ======================================================================
+
+   !! AXY (26/01/12)
+   SUBROUTINE trc_ini_medusa_river(kt)
+
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_ini_medusa_river  ***
+      !!
+      !! ** Purpose :   Read riverine nutrient fields
+      !!
+      !! ** Method  :   Read the file
+      !!
+      !! ** input   :   external netcdf files
+      !!
+      !!----------------------------------------------------------------------
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+
+      !!---------------------------------------------------------------------
+
+      IF(lwp) THEN
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' **** Routine trc_ini_medusa_river'
+         WRITE(numout,*) ' '
+      ENDIF
+
+      !! Open and read the files
+      !! -----------------------
+      !!
+      if (jriver_n.gt.0) then
+         if (jriver_n.eq.1) CALL iom_open ( 'river_N_conc_orca100.nc', numriv )
+         if (jriver_n.eq.2) CALL iom_open ( 'river_N_flux_orca100.nc', numriv )
+         CALL iom_get  ( numriv, jpdom_data, 'RIV_N', riv_n )
+         IF(lwp) THEN
+            if (jriver_n.eq.1) WRITE(numout,*) ' **** trc_ini_medusa_river: N CONC data read'
+            if (jriver_n.eq.2) WRITE(numout,*) ' **** trc_ini_medusa_river: N FLUX data read'
+         ENDIF
+         CALL iom_close ( numriv )
+         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_river: river N file closed'
+      else
+         IF(lwp) THEN
+            WRITE(numout,*) ' **** trc_ini_medusa_river: N data NOT read'
+         ENDIF
+      endif
+      !!
+      if (jriver_si.gt.0) then
+         if (jriver_si.eq.1) CALL iom_open ( 'river_Si_conc_orca100.nc', numriv )
+         if (jriver_si.eq.2) CALL iom_open ( 'river_Si_flux_orca100.nc', numriv )
+         CALL iom_get  ( numriv, jpdom_data, 'RIV_SI', riv_si )
+         IF(lwp) THEN
+            if (jriver_si.eq.1) WRITE(numout,*) ' **** trc_ini_medusa_river: Si CONC data read'
+            if (jriver_si.eq.2) WRITE(numout,*) ' **** trc_ini_medusa_river: Si FLUX data read'
+         ENDIF
+         CALL iom_close ( numriv )
+         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_river: river Si file closed'
+      else
+         IF(lwp) THEN
+            WRITE(numout,*) ' **** trc_ini_medusa_river: Si data NOT read'
+         ENDIF
+      endif
+      !!
+      if (jriver_c.gt.0) then
+         if (jriver_c.eq.1) CALL iom_open ( 'river_C_conc_orca100.nc', numriv )
+         if (jriver_c.eq.2) CALL iom_open ( 'river_C_flux_orca100.nc', numriv )
+         CALL iom_get  ( numriv, jpdom_data, 'RIV_C', riv_c )
+         IF(lwp) THEN
+            if (jriver_c.eq.1) WRITE(numout,*) ' **** trc_ini_medusa_river: C CONC data read'
+            if (jriver_c.eq.2) WRITE(numout,*) ' **** trc_ini_medusa_river: C FLUX data read'
+         ENDIF
+         CALL iom_close ( numriv )
+         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_river: river C file closed'
+      else
+         IF(lwp) THEN
+            WRITE(numout,*) ' **** trc_ini_medusa_river: C data NOT read'
+         ENDIF
+      endif
+      !!
+      if (jriver_alk.gt.0) then
+         if (jriver_alk.eq.1) CALL iom_open ( 'river_alk_conc_orca100.nc', numriv )
+         if (jriver_alk.eq.2) CALL iom_open ( 'river_alk_flux_orca100.nc', numriv )
+         CALL iom_get  ( numriv, jpdom_data, 'RIV_ALK', riv_alk )
+         IF(lwp) THEN
+            if (jriver_alk.eq.1) WRITE(numout,*) ' **** trc_ini_medusa_river: alkalinity CONC data read'
+            if (jriver_alk.eq.2) WRITE(numout,*) ' **** trc_ini_medusa_river: alkalinity FLUX data read'
+         ENDIF
+         CALL iom_close ( numriv )
+         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_river: river alkalinity file closed'
+      else
+         IF(lwp) THEN
+            WRITE(numout,*) ' **** trc_ini_medusa_river: alkalinity data NOT read'
+         ENDIF
+      endif
+      IF(lwp) CALL flush(numout)
+
+   END SUBROUTINE trc_ini_medusa_river
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                                        No MEDUSA model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_ini_medusa             ! Empty routine
+   END SUBROUTINE trc_ini_medusa
+#endif
+
+   !!======================================================================
+END MODULE trcini_medusa
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcnam_medusa.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcnam_medusa.F90	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcnam_medusa.F90	(revision 8201)
@@ -0,0 +1,2447 @@
+MODULE trcnam_medusa
+   !!======================================================================
+   !!                      ***  MODULE trcnam_medusa  ***
+   !! TOP :   initialisation of some run parameters for MEDUSA bio-model
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code
+   !!              -   !  2008-08  (K. Popova) adaptation for MEDUSA
+   !!              -   !  2008-11  (A. Yool) continuing adaptation for MEDUSA
+   !!              -   !  2010-03  (A. Yool) updated for branch inclusion
+   !!              -   !  2011-04  (A. Yool) updated for ROAM project
+   !!              -   !  2013-05  (A. Yool) renamed (from trclsm) for v3.5
+   !!              -   !  2015-11  (J. Palmieri) added iom_use for diags
+   !!              -   !  2016-11  (A. Yool) updated diags for CMIP6
+   !!----------------------------------------------------------------------
+#if defined key_medusa
+   !!----------------------------------------------------------------------
+   !!   'key_medusa'   :                                       MEDUSA model
+   !!----------------------------------------------------------------------
+   !! trc_nam_medusa      : MEDUSA model initialisation
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! Ocean variables
+   USE par_trc         ! TOP parameters
+   USE trc             ! TOP variables
+   USE sms_medusa      ! sms trends
+   USE iom             ! I/O manager
+   !!USE trc_nam_dia     ! JPALM 13-11-2015 -- if iom_use for diag
+
+   !! AXY (04/02/14): necessary to find NaNs on HECTOR
+   USE, INTRINSIC :: ieee_arithmetic 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_nam_medusa       ! called by trcnam.F90 module
+   PUBLIC   trc_nam_iom_medusa   ! called by trcnam.F90 module
+
+   !!* Substitution
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_nam_medusa
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_nam_medusa  ***  
+      !!
+      !! ** Purpose :   read MEDUSA namelist
+      !!
+      !! ** input   :   file 'namelist.trc.sms' containing the following
+      !!             namelist: natbio, natopt, and natdbi ("key_trc_diabio")
+      !!
+      !! ekp: namelist nabio contains ALL parameters of the ecosystem 
+      !!      point sourses and sinks PLUS sediment exchange
+      !!      dia_bio - used by Lobster to output all point terms 
+      !!                (sourses and sinks of bio)
+      !!      dia_add - additional diagnostics for biology such as 
+      !!                primary production (2d depth integrated field or 3d)
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER            :: ji,jj,jk
+      REAL(wp)           :: fthk, fdep, fdep1
+      REAL(wp)           :: q1, q2, q3
+      !
+      NAMELIST/natbio/ xxi,xaln,xald,jphy,xvpn,xvpd,          &
+      &    xsin0,xnsi0,xuif,jliebig, jq10,                    &
+      &    xthetam,xthetamd,xnln,xnld,xsld,xfln,xfld,         &
+      &  xgmi,xgme,xkmi,xkme,xphi,xbetan,xbetac,xkc,          &
+      &    xpmipn,xpmid,xpmepn,xpmepd,xpmezmi,xpmed,          &
+      &  xmetapn,xmetapd,xmetazmi,xmetazme,                   &
+      &  jmpn,xmpn,xkphn,jmpd,xmpd,xkphd,jmzmi,xmzmi,xkzmi,   &
+      &    jmzme,xmzme,xkzme,jmd,jsfd,xmd,xmdc,               &
+      &  xthetapn,xthetapd,xthetazmi,xthetazme,xthetad,       &
+      &    xrfn,xrsn,vsed,xhr,                                &
+      &  jiron,xfe_mass,xfe_sol,xfe_sed,xLgT,xk_FeL,xk_sc_Fe, &
+      &  jexport,jfdfate,jrratio,jocalccd,xridg_r0,           &
+      &    xfdfrac1,xfdfrac2,xfdfrac3,                        &
+      &    xcaco3a,xcaco3b,xmassc,xmassca,xmasssi,xprotca,    &
+      &    xprotsi,xfastc,xfastca,xfastsi,                    &
+      &  jorgben,jinorgben,xsedn,xsedfe,xsedsi,xsedc,xsedca,  &
+      &    xburial,                                           &
+      &  jriver_n,jriver_si,jriver_c,jriver_alk,jriver_dep,   &
+      &  xsdiss,                                              &
+      &  sedlam,sedlostpoc,jpkb,jdms,jdms_input,jdms_model
+#if defined key_roam
+      NAMELIST/natroam/ xthetaphy,xthetazoo,xthetanit,        &
+      &    xthetarem,xo2min 
+#endif
+      NAMELIST/natopt/xkg0,xkr0,xkgp,xkrp,xlg,xlr,rpig
+      INTEGER :: jl, jn
+      INTEGER :: ios                 ! Local integer output status for namelist read
+      TYPE(DIAG), DIMENSION(jp_medusa_2d)  :: meddia2d
+      TYPE(DIAG), DIMENSION(jp_medusa_3d)  :: meddia3d
+      TYPE(DIAG), DIMENSION(jp_medusa_trd) :: meddiabio
+      CHARACTER(LEN=32)   ::   clname
+      !!
+      NAMELIST/nammeddia/ meddia3d, meddia2d     ! additional diagnostics
+
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      clname = 'namelist_medusa'
+      IF(lwp) WRITE(numout,*) ' trc_nam_medusa: read MEDUSA namelist'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+# if defined key_debug_medusa
+      CALL flush(numout)
+# endif
+
+
+      CALL ctl_opn( numnatp_ref, TRIM( clname )//'_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+      CALL ctl_opn( numnatp_cfg, TRIM( clname )//'_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+      IF(lwm) CALL ctl_opn( numonp     , 'output.namelist.pis' , 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+
+# if defined key_debug_medusa
+      CALL flush(numout)
+      IF (lwp) write (numout,*) '------------------------------'
+      IF (lwp) write (numout,*) 'Jpalm - debug'
+      IF (lwp) write (numout,*) 'open namelist_medusa -- OK'
+      IF (lwp) write (numout,*) 'Now, read namilists inside :'
+      IF (lwp) write (numout,*) ' '
+# endif
+      !
+# if defined key_debug_medusa
+      CALL flush(numout)
+# endif
+      !
+# if defined key_debug_medusa
+      IF (lwp) write (numout,*) '------------------------------'
+      IF (lwp) write (numout,*) 'Jpalm - debug'
+      IF (lwp) write (numout,*) 'Just before reading namelist_medusa :: nammeddia'
+      IF (lwp) write (numout,*) ' '
+      CALL flush(numout)
+# endif
+
+     IF( ( .NOT.lk_iomput .AND. ln_diatrc ) .OR. ( ln_diatrc .AND. lk_medusa ) ) THEN
+         !
+         ! Namelist nammeddia
+         ! -------------------
+         REWIND( numnatp_ref )              ! Namelist nammeddia in reference namelist : MEDUSA diagnostics
+         READ  ( numnatp_ref, nammeddia, IOSTAT = ios, ERR = 901)
+901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammeddia in reference namelist', lwp )
+
+         REWIND( numnatp_cfg )              ! Namelist nammeddia in configuration namelist : MEDUSA diagnostics
+         READ  ( numnatp_cfg, nammeddia, IOSTAT = ios, ERR = 902 )
+902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammeddia in configuration namelist', lwp )
+         IF(lwm) WRITE ( numonp, nammeddia )
+
+# if defined key_debug_medusa
+         IF (lwp) write (numout,*) '------------------------------'
+         IF (lwp) write (numout,*) 'Jpalm - debug'
+         IF (lwp) write (numout,*) 'reading namelist_medusa :: nammeddia OK'
+         IF (lwp) write (numout,*) 'Check number of variable in nammeddia:'
+         IF (lwp) write (numout,*) 'jp_medusa_2d: ',jp_medusa_2d ,'jp_medusa_3d: ',jp_medusa_3d
+         IF (lwp) write (numout,*) ' '
+         CALL flush(numout)
+# endif
+         DO jl = 1, jp_medusa_2d
+            jn = jp_msa0_2d + jl - 1
+# if defined key_debug_medusa
+            IF (lwp) write (numout,*) 'Check what is readden in nammeddia: -- 2D'
+            IF (lwp) write (numout,*) jl,'meddia2d-sname: ',meddia2d(jl)%sname 
+            IF (lwp) write (numout,*) jl,'meddia2d-lname: ',meddia2d(jl)%lname 
+            IF (lwp) write (numout,*) jl,'meddia2d-units: ',meddia2d(jl)%units 
+            CALL flush(numout)
+# endif
+            ctrc2d(jn) = meddia2d(jl)%sname
+            ctrc2l(jn) = meddia2d(jl)%lname
+            ctrc2u(jn) = meddia2d(jl)%units
+         END DO
+
+         DO jl = 1, jp_medusa_3d
+            jn = jp_msa0_3d + jl - 1
+# if defined key_debug_medusa
+            IF (lwp) write (numout,*) 'Check what is readden in nammeddia: -- 3D'
+            IF (lwp) write (numout,*) jl,'meddia3d-sname: ',meddia3d(jl)%sname 
+            IF (lwp) write (numout,*) jl,'meddia3d-lname: ',meddia3d(jl)%lname
+            IF (lwp) write (numout,*) jl,'meddia3d-units: ',meddia3d(jl)%units
+            CALL flush(numout)
+# endif
+            ctrc3d(jn) = meddia3d(jl)%sname
+            ctrc3l(jn) = meddia3d(jl)%lname
+            ctrc3u(jn) = meddia3d(jl)%units
+         END DO
+
+         IF(lwp) THEN                   ! control print
+# if defined key_debug_medusa
+            IF (lwp) write (numout,*) '------------------------------'
+            IF (lwp) write (numout,*) 'Jpalm - debug'
+            IF (lwp) write (numout,*) 'Var name assignation OK'
+            IF (lwp) write (numout,*) 'next check var names'
+            IF (lwp) write (numout,*) ' '
+            CALL flush(numout)
+# endif
+            WRITE(numout,*)
+            WRITE(numout,*) ' Namelist : natadd'
+            DO jl = 1, jp_medusa_3d
+               jn = jp_msa0_3d + jl - 1
+               WRITE(numout,*) '  3d diag nb : ', jn, '    short name : ', ctrc3d(jn), &
+                 &             '  long name  : ', ctrc3l(jn), '   unit : ', ctrc3u(jn)
+            END DO
+            WRITE(numout,*) ' '
+
+            DO jl = 1, jp_medusa_2d
+               jn = jp_msa0_2d + jl - 1
+               WRITE(numout,*) '  2d diag nb : ', jn, '    short name : ', ctrc2d(jn), &
+                 &             '  long name  : ', ctrc2l(jn), '   unit : ', ctrc2u(jn)
+            END DO
+            WRITE(numout,*) ' '
+         ENDIF
+         !
+      ENDIF   
+         !
+# if defined key_debug_medusa
+            CALL flush(numout)
+# endif
+
+      ! 1.4 namelist natbio : biological parameters
+      ! -------------------------------------------
+      
+      xxi         = 0.
+      xaln        = 0.
+      xald        = 0.
+      jphy        = 0
+      xvpn        = 0.
+      xvpd        = 0.
+      xthetam     = 0.
+      xthetamd    = 0.
+!!
+      xsin0       = 0.
+      xnsi0       = 0.
+      xuif        = 0.
+!!
+      jliebig     = 0
+      jq10        = 0.
+      xnln        = 0.
+      xnld        = 0.
+      xsld        = 0.
+      xfln        = 0.
+      xfld        = 0.
+!!
+      xgmi        = 0.
+      xgme        = 0.
+      xkmi        = 0.
+      xkme        = 0.
+      xphi	  = 0.
+      xbetan      = 0.
+      xbetac      = 0.
+      xkc         = 0.
+      xpmipn      = 0.
+      xpmid       = 0.
+      xpmepn      = 0.
+      xpmepd      = 0.
+      xpmezmi     = 0.
+      xpmed       = 0.
+!!
+      xmetapn     = 0.
+      xmetapd     = 0.
+      xmetazmi    = 0.
+      xmetazme    = 0.
+!!
+      jmpn        = 0
+      xmpn        = 0.
+      xkphn       = 0.
+      jmpd        = 0
+      xmpd        = 0.
+      xkphd       = 0.
+      jmzmi       = 0
+      xmzmi       = 0.
+      xkzmi       = 0.
+      jmzme       = 0
+      xmzme       = 0.
+      xkzme       = 0.
+!!
+      jmd         = 0
+      jsfd        = 0
+      xmd         = 0.
+      xmdc        = 0.
+!!
+      xthetapn    = 0.
+      xthetapd    = 0.
+      xthetazmi   = 0.
+      xthetazme   = 0.
+      xthetad     = 0.
+      xrfn        = 0.
+      xrsn        = 0.  !: (NOT USED HERE; RETAINED FOR LOBSTER)
+!!
+      jiron       = 0
+      xfe_mass    = 0.
+      xfe_sol     = 0.
+      xfe_sed     = 0.
+      xLgT        = 0.
+      xk_FeL	  = 0.
+      xk_sc_Fe    = 0.
+!!
+      jexport     = 0
+      jfdfate     = 0
+      jrratio     = 0
+      jocalccd    = 0
+      xridg_r0    = 0.
+      xfdfrac1	  = 0.
+      xfdfrac2	  = 0.
+      xfdfrac3	  = 0.
+      xcaco3a	  = 0.
+      xcaco3b	  = 0.
+      xmassc	  = 0.
+      xmassca	  = 0.
+      xmasssi	  = 0.
+      xprotca	  = 0.
+      xprotsi	  = 0.
+      xfastc	  = 0.
+      xfastca	  = 0.
+      xfastsi	  = 0.
+!!
+      jorgben     = 0
+      jinorgben   = 0
+      xsedn       = 0.
+      xsedfe      = 0.
+      xsedsi      = 0.
+      xsedc       = 0.
+      xsedca      = 0.
+      xburial     = 0.
+!!
+      jriver_n    = 0
+      jriver_si   = 0
+      jriver_c    = 0
+      jriver_alk  = 0
+      jriver_dep  = 1
+!!
+      xsdiss	  = 0.
+!!
+      vsed        = 0.
+      xhr         = 0.
+!!
+      sedlam	  = 0.
+      sedlostpoc  = 0.
+      jpkb	  = 0.
+      jdms        = 0
+      jdms_input  = 0
+      jdms_model  = 0
+            
+      !REWIND(numnatm)
+      !READ(numnatm,natbio)
+         ! Namelist natbio
+         ! -------------------
+         REWIND( numnatp_ref )              ! Namelist natbio in reference namelist : MEDUSA diagnostics
+         READ  ( numnatp_ref, natbio, IOSTAT = ios, ERR = 903)
+903      IF( ios /= 0 ) CALL ctl_nam ( ios , 'natbio in reference namelist', lwp )
+
+         REWIND( numnatp_cfg )              ! Namelist natbio in configuration namelist : MEDUSA diagnostics
+         READ  ( numnatp_cfg, natbio, IOSTAT = ios, ERR = 904 )
+904      IF( ios /= 0 ) CALL ctl_nam ( ios , 'natbio in configuration namelist', lwp )
+         IF(lwm) WRITE ( numonp, natbio )
+
+!! Primary production and chl related quantities
+!!       xxi         :  conversion factor from gC to mmolN 
+!!       xaln        :  Chl-a specific initial slope of P-I curve for non-diatoms 
+!!       xald        :  Chl-a specific initial slope of P-I curve for diatoms
+!!       jphy        :  phytoplankton T-dependent growth switch
+!!       xvpn        :  maximum growth rate for non-diatoms
+!!       xvpd        :  maximum growth rate for diatoms
+!!       xthetam     :  maximum Chl to C ratio for non-diatoms      
+!!       xthetamd    :  maximum Chl to C ratio for diatoms      
+!!
+!! Diatom silicon parameters
+!!       xsin0       :  minimum diatom Si:N ratio
+!!       xnsi0       :  minimum diatom N:Si ratio
+!!       xuif        :  hypothetical growth ratio at infinite Si:N ratio
+!!
+!! Nutrient limitation
+!!       jliebig     :  Liebig nutrient uptake switch
+!!       xnln        :  half-sat constant for DIN uptake by non-diatoms 
+!!       xnld        :  half-sat constant for DIN uptake by diatoms 
+!!       xsl         :  half-sat constant for Si uptake by diatoms 
+!!       xfld        :  half-sat constant for Fe uptake by diatoms  
+!!       xfln        :  half-sat constant for Fe uptake by non-datoms 
+!!
+!! Grazing
+!!       xgmi        :  microzoo maximum growth rate 
+!!       xgme        :  mesozoo maximum growth rate 
+!!       xkmi        :  microzoo grazing half-sat parameter
+!!       xkme        :  mesozoo grazing half-sat parameter
+!!       xphi        :  micro/mesozoo grazing inefficiency
+!!       xbetan      :  micro/mesozoo N assimilation efficiency
+!!       xbetac      :  micro/mesozoo C assimilation efficiency
+!!       xkc         :  micro/mesozoo net C growth efficiency
+!!       xpmipn      :  grazing preference of microzoo for non-diatoms
+!!       xpmid       :  grazing preference of microzoo for diatoms
+!!       xpmepn      :  grazing preference of mesozoo for non-diatoms 
+!!       xpmepd      :  grazing preference of mesozoo for diatoms
+!!       xpmezmi     :  grazing preference of mesozoo for microzoo
+!!       xpmed       :  grazing preference of mesozoo for detritus
+!!
+!! Metabolic losses
+!!       xmetapn     :  non-diatom metabolic loss rate
+!!       xmetapd     :  diatom     metabolic loss rate
+!!       xmetazmi    :  microzoo   metabolic loss rate
+!!       xmetazme    :  mesozoo    metabolic loss rate
+!!
+!! Mortality/Remineralisation
+!!       jmpn        :  non-diatom mortality functional form
+!!       xmpn        :  non-diatom mortality rate
+!!       xkphn       :  non-diatom mortality half-sat constant
+!!       jmpd        :  diatom     mortality functional form
+!!       xmpd        :  diatom mortality rate
+!!       xkphd       :  diatom mortality half-sat constant
+!!       jmzmi       :  microzoo   mortality functional form
+!!       xmzmi       :  microzoo mortality rate
+!!       xkzmi       :  microzoo mortality half-sat constant
+!!       jmzme       :  mesozoo    mortality functional form
+!!       xmzme       :  mesozoo mortality rate
+!!       xkzme       :  mesozoo mortality half-sat constant
+!!
+!! Remineralisation
+!!       jmd         :  detritus T-dependent remineralisation switch
+!!       jsfd        :  accelerate seafloor detritus remin. switch
+!!       xmd         :  detrital nitrogen remineralisation rate 
+!!       xmdc        :  detrital carbon remineralisation rate 
+!!
+!! Stochiometric ratios
+!!       xthetapn    :  non-diatom C:N ratio
+!!       xthetapd    :  diatom C:N ratio
+!!       xthetazmi   :  microzoo C:N ratio
+!!       xthetazme   :  mesozoo C:N ratio
+!!       xthetad     :  detritus C:N ratio
+!!       xrfn        :  phytoplankton Fe:N ratio
+!!	 xrsn        :  diatom Si:N ratio (*NOT* used)
+!!
+!! Iron parameters
+!!       jiron       :  iron scavenging submodel switch
+!!       xfe_mass    :  iron atomic mass
+!!	 xfe_sol     :  aeolian iron solubility
+!!	 xfe_sed     :  sediment iron input
+!!	 xLgT	     :  total ligand concentration (umol/m3)
+!!	 xk_FeL	     :  dissociation constant for (Fe + L)
+!!	 xk_sc_Fe    :  scavenging rate of "free" iron
+!!	 
+!! Fast-sinking detritus parameters
+!!       jexport     :  fast detritus remineralisation switch
+!!       jfdfate     :  fate of fast detritus at seafloor switch
+!!       jrratio     :  rain ratio switch
+!!       jocalccd    :  CCD switch
+!!       xridg_r0    :  Ridgwell rain ratio coefficient
+!!       xfdfrac1    :  fast-sinking fraction of diatom nat. mort. losses
+!!       xfdfrac2    :  fast-sinking fraction of meszooplankton mort. losses
+!!       xfdfrac3    :  fast-sinking fraction of diatom silicon grazing losses
+!!       xcaco3a     :  polar (high latitude) CaCO3 fraction
+!!       xcaco3b     :  equatorial (low latitude) CaCO3 fraction
+!!       xmassc      :  organic C mass:mole ratio, C106 H175 O40 N16 P1
+!!       xmassca     :  calcium carbonate mass:mole ratio, CaCO3
+!!       xmasssi     :  biogenic silicon mass:mole ratio, (H2SiO3)n
+!!       xprotca     :  calcium carbonate protection ratio
+!!       xprotsi     :  biogenic silicon protection ratio
+!!       xfastc      :  organic C remineralisation length scale
+!!       xfastca     :  calcium carbonate dissolution length scale
+!!       xfastsi     :  biogenic silicon dissolution length scale
+!!
+!! Benthic 
+!!       jorgben     :  does   organic detritus go to the benthos?
+!!       jinorgben   :  does inorganic detritus go to the benthos?
+!!       xsedn       :  organic   nitrogen sediment remineralisation rate 
+!!       xsedfe      :  organic   iron     sediment remineralisation rate 
+!!       xsedsi      :  inorganic silicon  sediment dissolution      rate 
+!!       xsedc       :  organic   carbon   sediment remineralisation rate 
+!!       xsedca      :  inorganic carbon   sediment dissolution      rate 
+!!       xburial     :  burial rate of seafloor detritus
+!!
+!! Riverine inputs
+!!       jriver_n    :  riverine N          input?
+!!       jriver_si   :  riverine Si         input?
+!!       jriver_c    :  riverine C          input?
+!!       jriver_alk  :  riverine alkalinity input?
+!!       jriver_dep  :  depth of riverine   input?
+!!
+!! Miscellaneous
+!!       xsdiss      :  diatom frustule dissolution rate
+!!
+!! Gravitational sinking      
+!!       vsed        :  detritus gravitational sinking rate 
+!!       xhr         :  coeff for Martin's remineralisation profile
+!!
+!! Additional parameters
+!!       sedlam      :  time coeff of POC in sediments
+!!      sedlostpoc   :  sediment geol loss for POC
+!!       jpkb        :  vertical layer for diagnostic of the vertical flux 
+!!                      NOTE that in LOBSTER it is a first vertical layers where 
+!!                      biology is active  
+!!
+!! UKESM1 - new diagnostics  !! Jpalm
+!!       jdms        :  include dms diagnostics
+!!	 jdms_input  :  use instant (0) or diel-avg (1) inputs
+!!       jdms_model  :  choice of DMS model passed to atmosphere
+!!                      1 = ANDR, 2 = SIMO, 3 = ARAN, 4 = HALL, 5 = ANDM
+!!
+      IF(lwp) THEN
+!!
+!! AXY (08/11/13): compilation key notification
+         WRITE(numout,*) '=== Compilation keys'
+#if defined key_roam
+         WRITE(numout,*)     &
+         &   ' key_roam                                                               = ACTIVE'
+#else
+         WRITE(numout,*)     &
+         &   ' key_roam                                                               = INACTIVE'
+#endif        
+#if defined key_axy_carbchem
+         WRITE(numout,*)     &
+         &   ' key_axy_carbchem                                                       = ACTIVE'
+#else
+         WRITE(numout,*)     &
+         &   ' key_axy_carbchem                                                       = INACTIVE'
+#endif        
+#if defined key_mocsy
+         WRITE(numout,*)     &
+         &   ' key_mocsy                                                              = ACTIVE'
+#else
+         WRITE(numout,*)     &
+         &   ' key_mocsy                                                              = INACTIVE'
+#endif        
+#if defined key_avgqsr_medusa
+         WRITE(numout,*)     &
+         &   ' key_avgqsr_medusa                                                      = ACTIVE'
+#else
+         WRITE(numout,*)     &
+         &   ' key_avgqsr_medusa                                                      = INACTIVE'
+#endif        
+#if defined key_bs_axy_zforce
+         WRITE(numout,*)     &
+         &   ' key_bs_axy_zforce                                                      = ACTIVE'
+#else
+         WRITE(numout,*)     &
+         &   ' key_bs_axy_zforce                                                      = INACTIVE'
+#endif        
+#if defined key_bs_axy_yrlen
+         WRITE(numout,*)     &
+         &   ' key_bs_axy_yrlen                                                       = ACTIVE'
+#else
+         WRITE(numout,*)     &
+         &   ' key_bs_axy_yrlen                                                       = INACTIVE'
+#endif        
+#if defined key_deep_fe_fix
+         WRITE(numout,*)     &
+         &   ' key_deep_fe_fix                                                        = ACTIVE'
+#else
+         WRITE(numout,*)     &
+         &   ' key_deep_fe_fix                                                        = INACTIVE'
+#endif        
+#if defined key_axy_nancheck
+         WRITE(numout,*)     &
+         &   ' key_axy_nancheck                                                       = ACTIVE'
+#else
+         WRITE(numout,*)     &
+         &   ' key_axy_nancheck                                                       = INACTIVE'
+#endif        
+# if defined key_axy_pi_co2
+         WRITE(numout,*)     &
+         &   ' key_axy_pi_co2                                                         = ACTIVE'
+#else
+         WRITE(numout,*)     &
+         &   ' key_axy_pi_co2                                                         = INACTIVE'
+# endif
+# if defined key_debug_medusa
+         WRITE(numout,*)     &
+         &   ' key_debug_medusa                                                       = ACTIVE'
+#else
+         WRITE(numout,*)     &
+         &   ' key_debug_medusa                                                       = INACTIVE'
+# endif
+         WRITE(numout,*) ' '
+
+         WRITE(numout,*) 'natbio'
+         WRITE(numout,*) ' '
+!!
+!! Primary production and chl related quantities
+         WRITE(numout,*) '=== Primary production'
+         WRITE(numout,*)     &
+         &   ' conversion factor from gC to mmolN,                        xxi         =', xxi
+         WRITE(numout,*)     &
+         &   ' Chl-a specific initial slope of P-I curve for non-diatoms, xaln        = ', xaln
+         WRITE(numout,*)     &
+         &   ' Chl-a specific initial slope of P-I curve for diatoms,     xald        = ', xald
+         if (jphy.eq.1) then
+            WRITE(numout,*) &
+            &   ' phytoplankton growth is *temperature-dependent*            jphy        = ', jphy
+         elseif (jphy.eq.2) then
+            WRITE(numout,*) &
+            &   ' phytoplankton growth is *temperature-dependent(Q10)*       jphy        = ', jphy
+         elseif (jphy.eq.0) then
+            WRITE(numout,*) &
+            &   ' phytoplankton growth is *temperature-independent*          jphy        = ', jphy
+         endif
+         WRITE(numout,*)     &
+         &   ' maximum growth rate for non-diatoms,                       xvpn        = ', xvpn
+         WRITE(numout,*)     &
+         &   ' maximum growth rate for diatoms,                           xvpn        = ', xvpd
+         WRITE(numout,*)     &
+         &   ' maximum Chl to C ratio for non-diatoms,                    xthetam     = ', xthetam
+         WRITE(numout,*)     &
+         &   ' maximum Chl to C ratio for diatoms,                        xthetamd    = ', xthetamd
+         WRITE(numout,*)     &
+         &   ' specific Q10 value (jphy==2),                                  jq10    = ', jq10
+!!
+!! Diatom silicon parameters
+         WRITE(numout,*) '=== Diatom silicon parameters'
+         WRITE(numout,*)     &
+         &   ' minimum diatom Si:N ratio,                                 xsin0       = ', xsin0
+         WRITE(numout,*)     &
+         &   ' minimum diatom N:Si ratio,                                 xnsi0       = ', xnsi0
+         WRITE(numout,*)     &
+         &   ' hypothetical growth ratio at infinite Si:N ratio,          xuif        = ', xuif
+!!
+!! Nutrient limitation
+         WRITE(numout,*) '=== Nutrient limitation'
+         if (jliebig.eq.1) then
+            WRITE(numout,*) &
+            &   ' nutrient uptake is a Liebig Law (= most limiting) function jliebig     = ', jliebig
+         elseif (jliebig.eq.0) then
+            WRITE(numout,*) &
+            &   ' nutrient uptake is a multiplicative function               jliebig     = ', jliebig
+         endif
+         WRITE(numout,*)     &
+         &   ' half-sat constant for DIN uptake by non-diatoms,           xnln        = ', xnln
+         WRITE(numout,*)     &
+         &   ' half-sat constant for DIN uptake by diatoms,               xnld        = ', xnld
+         WRITE(numout,*)     &
+         &   ' half-sat constant for Si uptake by diatoms,                xsld        = ', xsld
+         WRITE(numout,*)     &
+         &   ' half-sat constant for Fe uptake by non-diatoms,            xfln        = ', xfln
+         WRITE(numout,*)     &
+         &   ' half-sat constant for Fe uptake by diatoms,                xfld        = ', xfld
+!!
+!! Grazing
+         WRITE(numout,*) '=== Zooplankton grazing'
+         WRITE(numout,*)     &
+         &   ' microzoo maximum growth rate,                              xgmi        = ', xgmi
+         WRITE(numout,*)     &
+         &   ' mesozoo maximum growth rate,                               xgme        = ', xgme
+         WRITE(numout,*)     &
+         &   ' microzoo grazing half-sat parameter,                       xkmi        = ', xkmi
+         WRITE(numout,*)     &
+         &   ' mesozoo grazing half-sat parameter,                        xkme        = ', xkme
+         WRITE(numout,*)     &
+         &   ' micro/mesozoo grazing inefficiency,                        xphi        = ', xphi
+         WRITE(numout,*)     &
+         &   ' micro/mesozoo N assimilation efficiency,                   xbetan      = ', xbetan
+         WRITE(numout,*)     &
+         &   ' micro/mesozoo C assimilation efficiency,                   xbetac      = ', xbetan
+         WRITE(numout,*)     &
+         &   ' micro/mesozoo net C growth efficiency,                     xkc         = ', xkc
+         WRITE(numout,*)     &
+         &   ' grazing preference of microzoo for non-diatoms,            xpmipn      = ', xpmipn
+         WRITE(numout,*)     &
+         &   ' grazing preference of microzoo for detritus,               xpmid       = ', xpmid
+         WRITE(numout,*)     &
+         &   ' grazing preference of mesozoo for non-diatoms,             xpmepn      = ', xpmepn
+         WRITE(numout,*)     &
+         &   ' grazing preference of mesozoo for diatoms,                 xpmepd      = ', xpmepd
+         WRITE(numout,*)     &
+         &   ' grazing preference of mesozoo for microzoo,                xpmezmi     = ', xpmezmi
+         WRITE(numout,*)     &
+         &   ' grazing preference of mesozoo for detritus,                xpmed       = ', xpmed
+!!
+!! Metabolic losses
+         WRITE(numout,*) '=== Metabolic losses'
+         WRITE(numout,*)     &
+         &   ' non-diatom metabolic loss rate,                            xmetapn     = ', xmetapn
+         WRITE(numout,*)     &
+         &   ' diatom     metabolic loss rate,                            xmetapd     = ', xmetapd
+         WRITE(numout,*)     &
+         &   ' microzoo   metabolic loss rate,                            xmetazmi    = ', xmetazmi
+         WRITE(numout,*)     &
+         &   ' mesozoo    metabolic loss rate,                            xmetazme    = ', xmetazme
+!!
+!! Mortality losses
+         WRITE(numout,*) '=== Mortality losses'
+         if (jmpn.eq.1) then
+            WRITE(numout,*)     &
+            &   ' non-diatom mortality functional form,            LINEAR    jmpn        = ', jmpn
+         elseif (jmpn.eq.2) then
+            WRITE(numout,*)     &
+            &   ' non-diatom mortality functional form,         QUADRATIC    jmpn        = ', jmpn
+         elseif (jmpn.eq.3) then
+            WRITE(numout,*)     &
+            &   ' non-diatom mortality functional form,        HYPERBOLIC    jmpn        = ', jmpn
+         elseif (jmpn.eq.4) then
+            WRITE(numout,*)     &
+            &   ' non-diatom mortality functional form,           SIGMOID    jmpn        = ', jmpn
+         endif
+         WRITE(numout,*)     &
+         &   ' non-diatom mortality rate,                                 xmpn        = ', xmpn
+         WRITE(numout,*)     &
+         &   ' non-diatom mortality half-sat constant                     xkphn       = ', xkphn
+         if (jmpd.eq.1) then
+            WRITE(numout,*)     &
+            &   ' diatom mortality functional form,                LINEAR    jmpd        = ', jmpd
+         elseif (jmpd.eq.2) then
+            WRITE(numout,*)     &
+            &   ' diatom mortality functional form,             QUADRATIC    jmpd        = ', jmpd
+         elseif (jmpd.eq.3) then
+            WRITE(numout,*)     &
+            &   ' diatom mortality functional form,            HYPERBOLIC    jmpd        = ', jmpd
+         elseif (jmpd.eq.4) then
+            WRITE(numout,*)     &
+            &   ' diatom mortality functional form,               SIGMOID    jmpd        = ', jmpd
+         endif
+         WRITE(numout,*)     &
+         &   ' diatom mortality rate,                                     xmpd        = ', xmpd
+         WRITE(numout,*)     &
+         &   ' diatom mortality half-sat constant                         xkphd       = ', xkphd
+         if (jmzmi.eq.1) then
+            WRITE(numout,*)     &
+            &   ' microzoo mortality functional form,              LINEAR    jmzmi       = ', jmzmi
+         elseif (jmzmi.eq.2) then
+            WRITE(numout,*)     &
+            &   ' microzoo mortality functional form,           QUADRATIC    jmzmi       = ', jmzmi
+         elseif (jmzmi.eq.3) then
+            WRITE(numout,*)     &
+            &   ' microzoo mortality functional form,          HYPERBOLIC    jmzmi       = ', jmzmi
+         elseif (jmzmi.eq.4) then
+            WRITE(numout,*)     &
+            &   ' microzoo mortality functional form,             SIGMOID    jmzmi       = ', jmzmi
+         endif
+         WRITE(numout,*)     &
+         &   ' microzoo mortality rate,                                   xmzmi       = ', xmzmi
+         WRITE(numout,*)     &
+         &   ' mesozoo mortality half-sat constant,                       xkzmi       = ', xkzmi
+         if (jmzme.eq.1) then
+            WRITE(numout,*)     &
+            &   ' mesozoo mortality functional form,               LINEAR    jmzme       = ', jmzme
+         elseif (jmzme.eq.2) then
+            WRITE(numout,*)     &
+            &   ' mesozoo mortality functional form,            QUADRATIC    jmzme       = ', jmzme
+         elseif (jmzme.eq.3) then
+            WRITE(numout,*)     &
+            &   ' mesozoo mortality functional form,           HYPERBOLIC    jmzme       = ', jmzme
+         elseif (jmzme.eq.4) then
+            WRITE(numout,*)     &
+            &   ' mesozoo mortality functional form,              SIGMOID    jmzme       = ', jmzme
+         endif
+         WRITE(numout,*)     &
+         &   ' mesozoo mortality rate,                                    xmzme       = ', xmzme
+         WRITE(numout,*)     &
+         &   ' mesozoo mortality half-sat constant,                       xkzme       = ', xkzme
+!!
+!! Remineralisation
+         WRITE(numout,*) '=== Remineralisation'
+         if (jmd.eq.1) then
+            WRITE(numout,*) &
+            &   ' detritus remineralisation is *temperature-dependent*       jmd         = ', jmd
+         elseif (jmd.eq.2) then
+            WRITE(numout,*) &
+            &   ' detritus remineralisation is *temperature-dependent(Q10)*  jmd         = ', jmd
+         elseif (jmd.eq.0) then
+            WRITE(numout,*) &
+            &   ' detritus remineralisation is *temperature-independent*     jmd         = ', jmd
+         endif
+         if (jsfd.eq.1) then
+            WRITE(numout,*) &
+            &   ' detritus seafloor remineralisation is *accelerated*        jsfd        = ', jsfd
+         else
+            WRITE(numout,*) &
+            &   ' detritus seafloor remineralisation occurs at same rate     jsfd        = ', jsfd
+         endif
+         WRITE(numout,*)     &
+         &   ' detrital nitrogen remineralisation rate,                   xmd         = ', xmd
+         WRITE(numout,*)     &
+         &   ' detrital carbon remineralisation rate,                     xmdc        = ', xmdc
+!!
+!! Stochiometric ratios
+         WRITE(numout,*) '=== Stoichiometric ratios'
+         WRITE(numout,*)     &
+         &   ' non-diatom C:N ratio,                                      xthetapn    = ', xthetapn
+         WRITE(numout,*)     &
+         &   ' diatom C:N ratio,                                          xthetapd    = ', xthetapd
+         WRITE(numout,*)     &
+         &   ' microzoo C:N ratio,                                        xthetazmi   = ', xthetazmi
+         WRITE(numout,*)     &
+         &   ' mesozoo C:N ratio,                                         xthetazme   = ', xthetazme
+         WRITE(numout,*)     &
+         &   ' detritus C:N ratio,                                        xthetad     = ', xthetad
+         WRITE(numout,*)     &
+         &   ' phytoplankton Fe:N ratio,                                  xrfn        = ', xrfn
+         WRITE(numout,*)     &
+         &   ' diatom Si:N ratio,                                         xrsn        = ', xrsn
+!!	  
+!! Iron parameters
+         WRITE(numout,*) '=== Iron parameters'
+         if (jiron.eq.1) then
+            WRITE(numout,*)     &
+            &   ' Dutkiewicz et al. (2005) iron scavenging                   jiron       = ', jiron
+         elseif (jiron.eq.2) then
+            WRITE(numout,*)     &
+            &   ' Moore et al. (2004) iron scavenging                        jiron       = ', jiron
+         elseif (jiron.eq.3) then
+            WRITE(numout,*)     &
+            &   ' Moore et al. (2008) iron scavenging                        jiron       = ', jiron
+         elseif (jiron.eq.4) then
+            WRITE(numout,*)     &
+            &   ' Galbraith et al. (2010) iron scavenging                    jiron       = ', jiron
+         else
+            WRITE(numout,*)     &
+            &   ' There is **no** iron scavenging                            jiron       = ', jiron
+         endif
+         WRITE(numout,*)     &
+         &   ' iron atomic mass,                                          xfe_mass    = ', xfe_mass
+         WRITE(numout,*)     &
+         &   ' aeolian iron solubility,                                   xfe_sol     = ', xfe_sol
+         WRITE(numout,*)     &
+         &   ' sediment iron input,                                       xfe_sed     = ', xfe_sed
+         WRITE(numout,*)     &
+         &   ' total ligand concentration (umol/m3),                      xLgT        = ', xLgT
+         WRITE(numout,*)     &
+         &   ' dissociation constant for (Fe + L),                        xk_FeL      = ', xk_FeL
+         WRITE(numout,*)     &
+         &   ' scavenging rate for free iron,                             xk_sc_Fe    = ', xk_sc_Fe
+!!
+!! Fast-sinking detritus parameters
+         WRITE(numout,*) '=== Fast-sinking detritus'
+         if (jexport.eq.1) then
+            WRITE(numout,*) &
+            &   ' fast-detritus remin. uses Dunne et al. (2007; ballast)     jexport     = ', jexport
+         elseif (jexport.eq.2) then
+            WRITE(numout,*) &
+            &   ' fast-detritus remin. uses Martin et al. (1987)             jexport     = ', jexport
+         elseif (jexport.eq.2) then
+            WRITE(numout,*) &
+            &   ' fast-detritus remin. uses Henson et al. (2011)             jexport     = ', jexport
+         endif
+         if (jfdfate.eq.1) then
+            WRITE(numout,*) &
+            &   ' fast-detritus reaching seafloor becomes slow-detritus      jfdfate     = ', jfdfate
+         elseif (jfdfate.eq.0) then
+            WRITE(numout,*) &
+            &   ' fast-detritus reaching seafloor instantly remineralised    jfdfate     = ', jfdfate
+         endif
+#if defined key_roam
+         if (jrratio.eq.0) then
+            WRITE(numout,*) &
+            &   ' Dunne et al. (2005) rain ratio submodel                    jrratio     = ', jrratio
+         elseif (jrratio.eq.1) then
+            WRITE(numout,*) &
+            &   ' Ridgwell et al. (2007) rain ratio submodel (surface omega) jrratio     = ', jrratio
+         elseif (jrratio.eq.2) then
+            WRITE(numout,*) &
+            &   ' Ridgwell et al. (2007) rain ratio submodel (3D omega)      jrratio     = ', jrratio
+         endif
+#else          
+         jrratio = 0
+         WRITE(numout,*) &
+         &   ' Dunne et al. (2005) rain ratio submodel                    jrratio     = ', jrratio
+#endif          
+#if defined key_roam
+         if (jocalccd.eq.0) then
+            WRITE(numout,*) &
+            &   ' Default, fixed CCD used                                    jocalccd    = ', jocalccd
+         elseif (jocalccd.eq.1) then
+            WRITE(numout,*) &
+            &   ' Calculated, dynamic CCD used                               jocalccd    = ', jocalccd
+         endif
+#else          
+         jocalccd = 0
+         WRITE(numout,*) &
+         &   ' Default, fixed CCD used                                    jocalccd    = ', jocalccd
+#endif
+         WRITE(numout,*)     &
+         &   ' Ridgwell rain ratio coefficient,                           xridg_r0    = ', xridg_r0
+         WRITE(numout,*)     &
+         &   ' fast-sinking fraction of diatom nat. mort. losses,         xfdfrac1    = ', xfdfrac1
+         WRITE(numout,*)     &
+         &   ' fast-sinking fraction of mesozooplankton mort. losses,     xfdfrac2    = ', xfdfrac2
+         WRITE(numout,*)     &
+         &   ' fast-sinking fraction of diatom silicon grazing losses,    xfdfrac3    = ', xfdfrac3
+         WRITE(numout,*)     &
+         &   ' polar (high latitude) CaCO3 fraction,                      xcaco3a     = ', xcaco3a
+         WRITE(numout,*)     &
+         &   ' equatorial (low latitude) CaCO3 fraction,                  xcaco3b     = ', xcaco3b
+         WRITE(numout,*)     &
+         &   ' organic C mass:mole ratio, C106 H175 O40 N16 P1,           xmassc      = ', xmassc
+         WRITE(numout,*)     &
+         &   ' calcium carbonate mass:mole ratio, CaCO3,                  xmassca     = ', xmassca
+         WRITE(numout,*)     &
+         &   ' biogenic silicon mass:mole ratio, (H2SiO3)n,               xmasssi     = ', xmasssi
+         WRITE(numout,*)     &
+         &   ' calcium carbonate protection ratio,                        xprotca     = ', xprotca
+         WRITE(numout,*)     &
+         &   ' biogenic silicon protection ratio,                         xprotsi     = ', xprotsi
+         WRITE(numout,*)     &
+         &   ' organic C remineralisation length scale,                   xfastc      = ', xfastc
+         WRITE(numout,*)     &
+         &   ' calcium carbonate dissolution length scale,                xfastca     = ', xfastca
+         WRITE(numout,*)     &
+         &   ' biogenic silicon dissolution length scale,                 xfastsi     = ', xfastsi
+!!
+!! Benthos parameters
+         WRITE(numout,*) '=== Benthos parameters'
+         WRITE(numout,*)     &
+         &   ' does   organic detritus go to the benthos?,                jorgben     = ', jorgben
+         WRITE(numout,*)     &
+         &   ' does inorganic detritus go to the benthos?,                jinorgben   = ', jinorgben
+!!
+!! Some checks on parameters related to benthos parameters
+         if (jorgben.eq.1 .and. jsfd.eq.1) then
+            !! slow detritus going to benthos at an accelerated rate
+            WRITE(numout,*) '  === WARNING! ==='
+            WRITE(numout,*) '  jsfd *and* jorgben are active - please check that you wish this'
+            WRITE(numout,*) '  === WARNING! ==='
+         endif
+         if (jorgben.eq.1 .and. jfdfate.eq.1) then
+            !! fast detritus going to benthos but via slow detritus
+            WRITE(numout,*) '  === WARNING! ==='
+            WRITE(numout,*) '  jfdfate *and* jorgben are active - please check that you wish this'
+            WRITE(numout,*) '  === WARNING! ==='
+         endif
+         if (jorgben.eq.0 .and. jinorgben.eq.1) then
+            !! inorganic fast detritus going to benthos but organic fast detritus is not
+            WRITE(numout,*) '  === WARNING! ==='
+            WRITE(numout,*) '  jinorgben is active but jorgben is not - please check that you wish this'
+            WRITE(numout,*) '  === WARNING! ==='
+         endif
+         WRITE(numout,*)     &
+         &   ' organic   nitrogen sediment remineralisation rate,         xsedn       = ', xsedn
+         WRITE(numout,*)     &
+         &   ' organic   iron     sediment remineralisation rate,         xsedfe      = ', xsedfe
+         WRITE(numout,*)     &
+         &   ' inorganic silicon  sediment remineralisation rate,         xsedsi      = ', xsedsi
+         WRITE(numout,*)     &
+         &   ' organic   carbon   sediment remineralisation rate,         xsedc       = ', xsedc
+         WRITE(numout,*)     &
+         &   ' inorganic carbon   sediment remineralisation rate,         xsedca      = ', xsedca
+         WRITE(numout,*)     &
+         &   ' burial rate of seafloor detritus,                          xburial     = ', xburial
+!!
+!! Riverine inputs
+         WRITE(numout,*) '=== Riverine inputs'
+         if (jriver_n.eq.0) then
+            WRITE(numout,*)     &
+            &   ' *no* riverine N input,                                     jriver_n    = ', jriver_n
+         elseif (jriver_n.eq.1) then
+            WRITE(numout,*)     &
+            &   ' riverine N concentrations specified,                       jriver_n    = ', jriver_n
+         elseif (jriver_n.eq.2) then
+            WRITE(numout,*)     &
+            &   ' riverine N inputs specified,                               jriver_n    = ', jriver_n
+         endif
+         if (jriver_si.eq.0) then
+            WRITE(numout,*)     &
+            &   ' *no* riverine Si input,                                    jriver_si   = ', jriver_si
+         elseif (jriver_si.eq.1) then
+            WRITE(numout,*)     &
+            &   ' riverine Si concentrations specified,                      jriver_si   = ', jriver_si
+         elseif (jriver_si.eq.2) then
+            WRITE(numout,*)     &
+            &   ' riverine Si inputs specified,                              jriver_si   = ', jriver_si
+         endif
+         if (jriver_c.eq.0) then
+            WRITE(numout,*)     &
+            &   ' *no* riverine C input,                                     jriver_c    = ', jriver_c
+         elseif (jriver_c.eq.1) then
+            WRITE(numout,*)     &
+            &   ' riverine C concentrations specified,                       jriver_c    = ', jriver_c
+         elseif (jriver_c.eq.2) then
+            WRITE(numout,*)     &
+            &   ' riverine C inputs specified,                               jriver_c    = ', jriver_c
+         endif
+         if (jriver_alk.eq.0) then
+            WRITE(numout,*)     &
+            &   ' *no* riverine alkalinity input,                            jriver_alk  = ', jriver_alk
+         elseif (jriver_alk.eq.1) then
+            WRITE(numout,*)     &
+            &   ' riverine alkalinity concentrations specified,              jriver_alk  = ', jriver_alk
+         elseif (jriver_alk.eq.2) then
+            WRITE(numout,*)     &
+            &   ' riverine alkalinity inputs specified,                      jriver_alk  = ', jriver_alk
+         endif
+         !! AXY (19/07/12): prevent (gross) stupidity on part of user
+         if (jriver_dep.lt.1.or.jriver_dep.ge.jpk) then
+            jriver_dep = 1
+         endif
+         WRITE(numout,*)     &
+         &   ' riverine input applied to down to depth k = ...            jriver_dep  = ', jriver_dep
+!!
+!! Miscellaneous
+         WRITE(numout,*) '=== Miscellaneous'
+         WRITE(numout,*)     &
+         &   ' diatom frustule dissolution rate,                          xsdiss      = ', xsdiss
+!!
+!! Gravitational sinking      
+         WRITE(numout,*) '=== Gravitational sinking'
+         WRITE(numout,*)     &
+         &   ' detritus gravitational sinking rate,                       vsed        = ', vsed
+         WRITE(numout,*)     & 
+         &   ' coefficient for Martin et al. (1987) remineralisation,     xhr         = ', xhr
+!!
+!! Non-Medusa parameters
+         WRITE(numout,*) '=== Non-Medusa parameters'
+         WRITE(numout,*)     & 
+         &   ' time coeff of POC in sediments,                            sedlam      = ', sedlam
+         WRITE(numout,*)     &
+         &   ' Sediment geol loss for POC,                                sedlostpoc  = ', sedlostpoc
+         WRITE(numout,*)     &
+         &   ' Vert layer for diagnostic of vertical flux,                jpkp        = ', jpkb
+!!
+!! UKESM1 - new diagnostics  !! Jpalm; AXY (08/07/15)
+         WRITE(numout,*) '=== UKESM1-related parameters'
+         WRITE(numout,*)     &
+         &   ' include DMS diagnostic?,                                   jdms        = ', jdms
+         if (jdms_input .eq. 0) then
+            WRITE(numout,*)     &
+            &   ' use instant (0) or diel-avg (1) inputs,                    jdms_input  = instantaneous'
+         else
+            WRITE(numout,*)     &
+            &   ' use instant (0) or diel-avg (1) inputs,                    jdms_input  = diel-average'
+         endif
+	 if (jdms_model .eq. 1) then
+            WRITE(numout,*)     &
+            &   ' choice of DMS model passed to atmosphere,                  jdms_model  = Anderson et al. (2001)'
+	 elseif (jdms_model .eq. 2) then
+            WRITE(numout,*)     &
+            &   ' choice of DMS model passed to atmosphere,                  jdms_model  = Simo & Dachs (2002)'
+	 elseif (jdms_model .eq. 3) then
+            WRITE(numout,*)     &
+            &   ' choice of DMS model passed to atmosphere,                  jdms_model  = Aranami & Tsunogai (2004)'
+	 elseif (jdms_model .eq. 4) then
+            WRITE(numout,*)     &
+            &   ' choice of DMS model passed to atmosphere,                  jdms_model  = Halloran et al. (2010)'
+	 elseif (jdms_model .eq. 5) then
+            WRITE(numout,*)     &
+            &   ' choice of DMS model passed to atmosphere,                  jdms_model  = Anderson et al. (2001; modified)'
+         endif
+!!
+      ENDIF
+!!
+!! Key depth positions (with thanks to Andrew Coward for bug-fixing this bit)
+      DO jk = 1,jpk
+         !! level thickness
+         fthk  = e3t_1d(jk)
+         !! level depth (top of level)
+         fdep  = gdepw_1d(jk)
+         !! level depth (bottom of level)
+         fdep1 = fdep + fthk
+         !!
+         if (fdep.lt.100.0.AND.fdep1.gt.100.0) then        !  100 m
+            i0100 = jk
+         elseif (fdep.lt.150.0.AND.fdep1.gt.150.0) then    !  150 m (for BASIN)
+            i0150 = jk
+         elseif (fdep.lt.200.0.AND.fdep1.gt.200.0) then    !  200 m
+            i0200 = jk
+         elseif (fdep.lt.500.0.AND.fdep1.gt.500.0) then    !  500 m
+            i0500 = jk
+         elseif (fdep.lt.1000.0.AND.fdep1.gt.1000.0) then  ! 1000 m
+            i1000 = jk
+         elseif (fdep1.lt.1100.0) then                     ! 1100 m (for Moore et al. sedimentary iron)
+            i1100 = jk
+         endif
+      enddo
+      !!
+      IF(lwp) THEN
+          WRITE(numout,*) '=== Position of key depths'
+          WRITE(numout,*)     & 
+          &   ' jk position of  100 m horizon                              i0100       = ', i0100
+          WRITE(numout,*)     &
+          &   ' jk position of  150 m horizon                              i0150       = ', i0150
+          WRITE(numout,*)     & 
+          &   ' jk position of  200 m horizon                              i0200       = ', i0200
+          WRITE(numout,*)     & 
+          &   ' jk position of  500 m horizon                              i0500       = ', i0500
+          WRITE(numout,*)     & 
+          &   ' jk position of 1000 m horizon                              i1000       = ', i1000
+          WRITE(numout,*)     & 
+          &   ' jk position of 1100 m horizon [*]                          i1100       = ', i1100
+          WRITE(numout,*) 'Got here ' , SIZE(friver_dep)
+          CALL flush(numout)
+      ENDIF
+
+#if defined key_roam
+
+      ! 1.4b namelist natroam : ROAM parameters
+      ! ---------------------------------------
+      
+      xthetaphy = 0.
+      xthetazoo = 0.
+      xthetanit = 0.
+      xthetarem = 0.
+      xo2min    = 0.
+
+      !READ(numnatm,natroam)
+         ! Namelist natroam
+         ! -------------------
+         REWIND( numnatp_ref )              ! Namelist natroam in reference namelist : MEDUSA diagnostics
+         READ  ( numnatp_ref, natroam, IOSTAT = ios, ERR = 905)
+905      IF( ios /= 0 ) CALL ctl_nam ( ios , 'natroam in reference namelist', lwp )
+
+         REWIND( numnatp_cfg )              ! Namelist natroam in configuration namelist : MEDUSA diagnostics
+         READ  ( numnatp_cfg, natroam, IOSTAT = ios, ERR = 906 )
+906      IF( ios /= 0 ) CALL ctl_nam ( ios , 'natroam in configuration namelist', lwp )
+         IF(lwm) WRITE ( numonp, natroam )
+
+!! ROAM carbon, alkalinity and oxygen cycle parameters
+!!       xthetaphy :  oxygen evolution/consumption by phytoplankton
+!!       xthetazoo :  oxygen consumption by zooplankton
+!!       xthetanit :  oxygen consumption by nitrogen remineralisation
+!!       xthetarem :  oxygen consumption by carbon remineralisation
+!!       xo2min    :  oxygen minimum concentration
+
+      IF(lwp) THEN
+          WRITE(numout,*) 'natroam'
+          WRITE(numout,*) ' '
+!!
+!! ROAM carbon, alkalinity and oxygen cycle parameters
+          WRITE(numout,*) '=== ROAM carbon, alkalinity and oxygen cycle parameters'
+          WRITE(numout,*)     &
+          &   ' oxygen evolution/consumption by phytoplankton              xthetaphy   = ', xthetaphy
+          WRITE(numout,*)     &
+          &   ' oxygen consumption by zooplankton                          xthetazoo   = ', xthetazoo
+          WRITE(numout,*)     &
+          &   ' oxygen consumption by nitrogen remineralisation            xthetanit   = ', xthetanit
+          WRITE(numout,*)     &
+          &   ' oxygen consumption by carbon remineralisation              xthetarem   = ', xthetarem
+          WRITE(numout,*)     &
+          &   ' oxygen minimum concentration                               xo2min      = ', xo2min
+       ENDIF
+
+#endif
+
+      CALL flush(numout)
+
+      ! 1.5 namelist natopt : parameters for optic
+      ! ------------------------------------------
+
+      xkg0  = 0.
+      xkr0  = 0.
+      xkgp  = 0.
+      xkrp  = 0.
+      xlg   = 0.
+      xlr   = 0.
+      rpig  = 0.
+
+      !READ(numnatm,natopt)
+         ! Namelist natopt
+         ! -------------------
+         REWIND( numnatp_ref )              ! Namelist natopt in reference namelist : MEDUSA diagnostics
+         READ  ( numnatp_ref, natopt, IOSTAT = ios, ERR = 907)
+907      IF( ios /= 0 ) CALL ctl_nam ( ios , 'natopt in reference namelist', lwp )
+
+         REWIND( numnatp_cfg )              ! Namelist natopt in configuration namelist : MEDUSA diagnostics
+         READ  ( numnatp_cfg, natopt, IOSTAT = ios, ERR = 908 )
+908      IF( ios /= 0 ) CALL ctl_nam ( ios , 'natopt in configuration namelist', lwp )
+         IF(lwm) WRITE ( numonp, natopt )
+
+      IF(lwp) THEN
+         WRITE(numout,*) 'natopt'
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' green   water absorption coeff  xkg0  = ',xkg0
+         WRITE(numout,*) ' red water absorption coeff      xkr0  = ',xkr0
+         WRITE(numout,*) ' pigment red absorption coeff    xkrp  = ',xkrp
+         WRITE(numout,*) ' pigment green absorption coeff  xkgp  = ',xkgp
+         WRITE(numout,*) ' green chl exposant              xlg   = ',xlg
+         WRITE(numout,*) ' red   chl exposant              xlr   = ',xlr
+         WRITE(numout,*) ' chla/chla+phea ratio            rpig  = ',rpig
+         WRITE(numout,*) ' '
+
+      ENDIF
+
+      IF(lwp) THEN
+         WRITE(numout,*) 'NaN check'
+         WRITE(numout,*) ' '
+         q1 = -1.
+         q2 = 0.
+         q3 = log(q1)
+         write (numout,*) 'q3 = ', q3
+         if ( ieee_is_nan( q3 ) ) then
+            write (numout,*) 'NaN detected'
+         else
+            write (numout,*) 'NaN not detected'
+         endif
+         WRITE(numout,*) ' '
+       ENDIF
+
+   END SUBROUTINE trc_nam_medusa
+   
+   SUBROUTINE trc_nam_iom_medusa
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_nam_iom_medusa  ***
+      !!
+      !! ** Purpose : read all diag requested in iodef file through iom_use
+      !!              So it is done only once 
+      !!            ** All diagnostic MEDUSA could asked are registered in
+      !!            the med_diag type with a boolean value
+      !!            So if required, one diagnostic will be true.
+      !!
+      !!---------------------------------------------------------------------
+      !!
+      !!
+      !!----------------------------------------------------------------------            
+      !! Variable conventions
+      !!----------------------------------------------------------------------
+      !!
+      IF (iom_use("INVTN")) THEN 
+          med_diag%INVTN%dgsave = .TRUE.
+      ELSE 
+          med_diag%INVTN%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INVTSI")) THEN 
+          med_diag%INVTSI%dgsave = .TRUE.
+      ELSE 
+          med_diag%INVTSI%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INVTFE")) THEN 
+          med_diag%INVTFE%dgsave = .TRUE.
+      ELSE 
+          med_diag%INVTFE%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PRN")) THEN 
+          med_diag%PRN%dgsave = .TRUE.
+      ELSE 
+          med_diag%PRN%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("MPN")) THEN 
+          med_diag%MPN%dgsave = .TRUE.
+      ELSE 
+          med_diag%MPN%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PRD")) THEN 
+          med_diag%PRD%dgsave = .TRUE.
+      ELSE 
+          med_diag%PRD%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("MPD")) THEN 
+          med_diag%MPD%dgsave = .TRUE.
+      ELSE 
+          med_diag%MPD%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("DSED")) THEN 
+          med_diag%DSED%dgsave = .TRUE.
+      ELSE 
+          med_diag%DSED%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OPAL")) THEN 
+          med_diag%OPAL%dgsave = .TRUE.
+      ELSE 
+          med_diag%OPAL%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OPALDISS")) THEN 
+          med_diag%OPALDISS%dgsave = .TRUE.
+      ELSE 
+          med_diag%OPALDISS%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("GMIPn")) THEN 
+          med_diag%GMIPn%dgsave = .TRUE.
+      ELSE 
+          med_diag%GMIPn%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("GMID")) THEN 
+          med_diag%GMID%dgsave = .TRUE.
+      ELSE 
+          med_diag%GMID%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("MZMI")) THEN 
+          med_diag%MZMI%dgsave = .TRUE.
+      ELSE 
+          med_diag%MZMI%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("GMEPN")) THEN 
+          med_diag%GMEPN%dgsave = .TRUE.
+      ELSE 
+          med_diag%GMEPN%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("GMEPD")) THEN 
+          med_diag%GMEPD%dgsave = .TRUE.
+      ELSE 
+          med_diag%GMEPD%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("GMEZMI")) THEN 
+          med_diag%GMEZMI%dgsave = .TRUE.
+      ELSE 
+          med_diag%GMEZMI%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("GMED")) THEN 
+          med_diag%GMED%dgsave = .TRUE.
+      ELSE 
+          med_diag%GMED%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("MZME")) THEN 
+          med_diag%MZME%dgsave = .TRUE.
+      ELSE 
+          med_diag%MZME%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("DEXP")) THEN 
+          med_diag%DEXP%dgsave = .TRUE.
+      ELSE 
+          med_diag%DEXP%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("DETN")) THEN 
+          med_diag%DETN%dgsave = .TRUE.
+      ELSE 
+          med_diag%DETN%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("MDET")) THEN 
+          med_diag%MDET%dgsave = .TRUE.
+      ELSE 
+          med_diag%MDET%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("AEOLIAN")) THEN 
+          med_diag%AEOLIAN%dgsave = .TRUE.
+      ELSE 
+          med_diag%AEOLIAN%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("BENTHIC")) THEN 
+          med_diag%BENTHIC%dgsave = .TRUE.
+      ELSE 
+          med_diag%BENTHIC%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("SCAVENGE")) THEN 
+          med_diag%SCAVENGE%dgsave = .TRUE.
+      ELSE 
+          med_diag%SCAVENGE%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PN_JLIM")) THEN 
+          med_diag%PN_JLIM%dgsave = .TRUE.
+      ELSE 
+          med_diag%PN_JLIM%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PN_NLIM")) THEN 
+          med_diag%PN_NLIM%dgsave = .TRUE.
+      ELSE 
+          med_diag%PN_NLIM%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PN_FELIM")) THEN 
+          med_diag%PN_FELIM%dgsave = .TRUE.
+      ELSE 
+          med_diag%PN_FELIM%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PD_JLIM")) THEN 
+          med_diag%PD_JLIM%dgsave = .TRUE.
+      ELSE 
+          med_diag%PD_JLIM%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PD_NLIM")) THEN 
+          med_diag%PD_NLIM%dgsave = .TRUE.
+      ELSE 
+          med_diag%PD_NLIM%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PD_FELIM")) THEN 
+          med_diag%PD_FELIM%dgsave = .TRUE.
+      ELSE 
+          med_diag%PD_FELIM%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PD_SILIM")) THEN 
+          med_diag%PD_SILIM%dgsave = .TRUE.
+      ELSE 
+          med_diag%PD_SILIM%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PDSILIM2")) THEN 
+          med_diag%PDSILIM2%dgsave = .TRUE.
+      ELSE 
+          med_diag%PDSILIM2%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("SDT__100")) THEN 
+          med_diag%SDT__100%dgsave = .TRUE.
+      ELSE 
+          med_diag%SDT__100%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("SDT__200")) THEN 
+          med_diag%SDT__200%dgsave = .TRUE.
+      ELSE 
+          med_diag%SDT__200%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("SDT__500")) THEN 
+          med_diag%SDT__500%dgsave = .TRUE.
+      ELSE 
+          med_diag%SDT__500%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("SDT_1000")) THEN 
+          med_diag%SDT_1000%dgsave = .TRUE.
+      ELSE 
+          med_diag%SDT_1000%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("TOTREG_N")) THEN 
+          med_diag%TOTREG_N%dgsave = .TRUE.
+      ELSE 
+          med_diag%TOTREG_N%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("TOTRG_SI")) THEN 
+          med_diag%TOTRG_SI%dgsave = .TRUE.
+      ELSE 
+          med_diag%TOTRG_SI%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("REG__100")) THEN 
+          med_diag%REG__100%dgsave = .TRUE.
+      ELSE 
+          med_diag%REG__100%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("REG__200")) THEN 
+          med_diag%REG__200%dgsave = .TRUE.
+      ELSE 
+          med_diag%REG__200%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("REG__500")) THEN 
+          med_diag%REG__500%dgsave = .TRUE.
+      ELSE 
+          med_diag%REG__500%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("REG_1000")) THEN 
+          med_diag%REG_1000%dgsave = .TRUE.
+      ELSE 
+          med_diag%REG_1000%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FASTN")) THEN 
+          med_diag%FASTN%dgsave = .TRUE.
+      ELSE 
+          med_diag%FASTN%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FASTSI")) THEN 
+          med_diag%FASTSI%dgsave = .TRUE.
+      ELSE 
+          med_diag%FASTSI%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FASTFE")) THEN 
+          med_diag%FASTFE%dgsave = .TRUE.
+      ELSE 
+          med_diag%FASTFE%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FASTC")) THEN 
+          med_diag%FASTC%dgsave = .TRUE.
+      ELSE 
+          med_diag%FASTC%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FASTCA")) THEN 
+          med_diag%FASTCA%dgsave = .TRUE.
+      ELSE 
+          med_diag%FASTCA%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FDT__100")) THEN 
+          med_diag%FDT__100%dgsave = .TRUE.
+      ELSE 
+          med_diag%FDT__100%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FDT__200")) THEN 
+          med_diag%FDT__200%dgsave = .TRUE.
+      ELSE 
+          med_diag%FDT__200%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FDT__500")) THEN 
+          med_diag%FDT__500%dgsave = .TRUE.
+      ELSE 
+          med_diag%FDT__500%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FDT_1000")) THEN 
+          med_diag%FDT_1000%dgsave = .TRUE.
+      ELSE 
+          med_diag%FDT_1000%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("RG__100F")) THEN 
+          med_diag%RG__100F%dgsave = .TRUE.
+      ELSE 
+          med_diag%RG__100F%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("RG__200F")) THEN 
+          med_diag%RG__200F%dgsave = .TRUE.
+      ELSE 
+          med_diag%RG__200F%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("RG__500F")) THEN 
+          med_diag%RG__500F%dgsave = .TRUE.
+      ELSE 
+          med_diag%RG__500F%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("RG_1000F")) THEN 
+          med_diag%RG_1000F%dgsave = .TRUE.
+      ELSE 
+          med_diag%RG_1000F%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FDS__100")) THEN 
+          med_diag%FDS__100%dgsave = .TRUE.
+      ELSE 
+          med_diag%FDS__100%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FDS__200")) THEN 
+          med_diag%FDS__200%dgsave = .TRUE.
+      ELSE 
+          med_diag%FDS__200%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FDS__500")) THEN 
+          med_diag%FDS__500%dgsave = .TRUE.
+      ELSE 
+          med_diag%FDS__500%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FDS_1000")) THEN 
+          med_diag%FDS_1000%dgsave = .TRUE.
+      ELSE 
+          med_diag%FDS_1000%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("RGS_100F")) THEN 
+          med_diag%RGS_100F%dgsave = .TRUE.
+      ELSE 
+          med_diag%RGS_100F%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("RGS_200F")) THEN 
+          med_diag%RGS_200F%dgsave = .TRUE.
+      ELSE 
+          med_diag%RGS_200F%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("RGS_500F")) THEN 
+          med_diag%RGS_500F%dgsave = .TRUE.
+      ELSE 
+          med_diag%RGS_500F%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("RGS1000F")) THEN 
+          med_diag%RGS1000F%dgsave = .TRUE.
+      ELSE 
+          med_diag%RGS1000F%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("REMINN")) THEN 
+          med_diag%REMINN%dgsave = .TRUE.
+      ELSE 
+          med_diag%REMINN%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("REMINSI")) THEN 
+          med_diag%REMINSI%dgsave = .TRUE.
+      ELSE 
+          med_diag%REMINSI%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("REMINFE")) THEN 
+          med_diag%REMINFE%dgsave = .TRUE.
+      ELSE 
+          med_diag%REMINFE%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("REMINC")) THEN 
+          med_diag%REMINC%dgsave = .TRUE.
+      ELSE 
+          med_diag%REMINC%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("REMINCA")) THEN 
+          med_diag%REMINCA%dgsave = .TRUE.
+      ELSE 
+          med_diag%REMINCA%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("SEAFLRN")) THEN 
+          med_diag%SEAFLRN%dgsave = .TRUE.
+      ELSE 
+          med_diag%SEAFLRN%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("SEAFLRSI")) THEN 
+          med_diag%SEAFLRSI%dgsave = .TRUE.
+      ELSE 
+          med_diag%SEAFLRSI%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("SEAFLRFE")) THEN 
+          med_diag%SEAFLRFE%dgsave = .TRUE.
+      ELSE 
+          med_diag%SEAFLRFE%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("SEAFLRC")) THEN 
+          med_diag%SEAFLRC%dgsave = .TRUE.
+      ELSE 
+          med_diag%SEAFLRC%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("SEAFLRCA")) THEN 
+          med_diag%SEAFLRCA%dgsave = .TRUE.
+      ELSE 
+          med_diag%SEAFLRCA%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("MED_QSR")) THEN 
+          med_diag%MED_QSR%dgsave = .TRUE.
+      ELSE 
+          med_diag%MED_QSR%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("MED_XPAR")) THEN 
+          med_diag%MED_XPAR%dgsave = .TRUE.
+      ELSE 
+          med_diag%MED_XPAR%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INTFLX_N")) THEN 
+          med_diag%INTFLX_N%dgsave = .TRUE.
+      ELSE 
+          med_diag%INTFLX_N%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INTFLX_SI")) THEN 
+          med_diag%INTFLX_SI%dgsave = .TRUE.
+      ELSE 
+          med_diag%INTFLX_SI%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INTFLX_FE")) THEN 
+          med_diag%INTFLX_FE%dgsave = .TRUE.
+      ELSE 
+          med_diag%INTFLX_FE%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INT_PN")) THEN 
+          med_diag%INT_PN%dgsave = .TRUE.
+      ELSE 
+          med_diag%INT_PN%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INT_PD")) THEN 
+          med_diag%INT_PD%dgsave = .TRUE.
+      ELSE 
+          med_diag%INT_PD%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ML_PRN")) THEN 
+          med_diag%ML_PRN%dgsave = .TRUE.
+      ELSE 
+          med_diag%ML_PRN%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ML_PRD")) THEN 
+          med_diag%ML_PRD%dgsave = .TRUE.
+      ELSE 
+          med_diag%ML_PRD%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OCAL_CCD")) THEN 
+          med_diag%OCAL_CCD%dgsave = .TRUE.
+      ELSE 
+          med_diag%OCAL_CCD%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OCAL_LVL")) THEN 
+          med_diag%OCAL_LVL%dgsave = .TRUE.
+      ELSE 
+          med_diag%OCAL_LVL%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FE_0000")) THEN 
+          med_diag%FE_0000%dgsave = .TRUE.
+      ELSE 
+          med_diag%FE_0000%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FE_0100")) THEN 
+          med_diag%FE_0100%dgsave = .TRUE.
+      ELSE 
+          med_diag%FE_0100%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FE_0200")) THEN 
+          med_diag%FE_0200%dgsave = .TRUE.
+      ELSE 
+          med_diag%FE_0200%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FE_0500")) THEN 
+          med_diag%FE_0500%dgsave = .TRUE.
+      ELSE 
+          med_diag%FE_0500%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FE_1000")) THEN 
+          med_diag%FE_1000%dgsave = .TRUE.
+      ELSE 
+          med_diag%FE_1000%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("MED_XZE")) THEN 
+          med_diag%MED_XZE%dgsave = .TRUE.
+      ELSE 
+          med_diag%MED_XZE%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("WIND")) THEN 
+          med_diag%WIND%dgsave = .TRUE.
+      ELSE 
+          med_diag%WIND%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ATM_PCO2")) THEN 
+          med_diag%ATM_PCO2%dgsave = .TRUE.
+      ELSE 
+          med_diag%ATM_PCO2%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OCN_PH")) THEN 
+          med_diag%OCN_PH%dgsave = .TRUE.
+      ELSE 
+          med_diag%OCN_PH%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OCN_PCO2")) THEN 
+          med_diag%OCN_PCO2%dgsave = .TRUE.
+      ELSE 
+          med_diag%OCN_PCO2%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OCNH2CO3")) THEN 
+          med_diag%OCNH2CO3%dgsave = .TRUE.
+      ELSE 
+          med_diag%OCNH2CO3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OCN_HCO3")) THEN 
+          med_diag%OCN_HCO3%dgsave = .TRUE.
+      ELSE 
+          med_diag%OCN_HCO3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OCN_CO3")) THEN 
+          med_diag%OCN_CO3%dgsave = .TRUE.
+      ELSE 
+          med_diag%OCN_CO3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("CO2FLUX")) THEN 
+          med_diag%CO2FLUX%dgsave = .TRUE.
+      ELSE 
+          med_diag%CO2FLUX%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OM_CAL")) THEN 
+          med_diag%OM_CAL%dgsave = .TRUE.
+      ELSE 
+          med_diag%OM_CAL%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OM_ARG")) THEN 
+          med_diag%OM_ARG%dgsave = .TRUE.
+      ELSE 
+          med_diag%OM_ARG%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("TCO2")) THEN 
+          med_diag%TCO2%dgsave = .TRUE.
+      ELSE 
+          med_diag%TCO2%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("TALK")) THEN 
+          med_diag%TALK%dgsave = .TRUE.
+      ELSE 
+          med_diag%TALK%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("KW660")) THEN 
+          med_diag%KW660%dgsave = .TRUE.
+      ELSE 
+          med_diag%KW660%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ATM_PP0")) THEN 
+          med_diag%ATM_PP0%dgsave = .TRUE.
+      ELSE 
+          med_diag%ATM_PP0%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("O2FLUX")) THEN 
+          med_diag%O2FLUX%dgsave = .TRUE.
+      ELSE 
+          med_diag%O2FLUX%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("O2SAT")) THEN 
+          med_diag%O2SAT%dgsave = .TRUE.
+      ELSE 
+          med_diag%O2SAT%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("CAL_CCD")) THEN 
+          med_diag%CAL_CCD%dgsave = .TRUE.
+      ELSE 
+          med_diag%CAL_CCD%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ARG_CCD")) THEN 
+          med_diag%ARG_CCD%dgsave = .TRUE.
+      ELSE 
+          med_diag%ARG_CCD%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("SFR_OCAL")) THEN 
+          med_diag%SFR_OCAL%dgsave = .TRUE.
+      ELSE 
+          med_diag%SFR_OCAL%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("SFR_OARG")) THEN 
+          med_diag%SFR_OARG%dgsave = .TRUE.
+      ELSE 
+          med_diag%SFR_OARG%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("N_PROD")) THEN 
+          med_diag%N_PROD%dgsave = .TRUE.
+      ELSE 
+          med_diag%N_PROD%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("N_CONS")) THEN 
+          med_diag%N_CONS%dgsave = .TRUE.
+      ELSE 
+          med_diag%N_CONS%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("C_PROD")) THEN 
+          med_diag%C_PROD%dgsave = .TRUE.
+      ELSE 
+          med_diag%C_PROD%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("C_CONS")) THEN 
+          med_diag%C_CONS%dgsave = .TRUE.
+      ELSE 
+          med_diag%C_CONS%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("O2_PROD")) THEN 
+          med_diag%O2_PROD%dgsave = .TRUE.
+      ELSE 
+          med_diag%O2_PROD%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("O2_CONS")) THEN 
+          med_diag%O2_CONS%dgsave = .TRUE.
+      ELSE 
+          med_diag%O2_CONS%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("O2_ANOX")) THEN 
+          med_diag%O2_ANOX%dgsave = .TRUE.
+      ELSE 
+          med_diag%O2_ANOX%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("RR_0100")) THEN 
+          med_diag%RR_0100%dgsave = .TRUE.
+      ELSE 
+          med_diag%RR_0100%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("RR_0500")) THEN 
+          med_diag%RR_0500%dgsave = .TRUE.
+      ELSE 
+          med_diag%RR_0500%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("RR_1000")) THEN 
+          med_diag%RR_1000%dgsave = .TRUE.
+      ELSE 
+          med_diag%RR_1000%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("IBEN_N")) THEN 
+          med_diag%IBEN_N%dgsave = .TRUE.
+      ELSE 
+          med_diag%IBEN_N%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("IBEN_FE")) THEN 
+          med_diag%IBEN_FE%dgsave = .TRUE.
+      ELSE 
+          med_diag%IBEN_FE%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("IBEN_C")) THEN 
+          med_diag%IBEN_C%dgsave = .TRUE.
+      ELSE 
+          med_diag%IBEN_C%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("IBEN_SI")) THEN 
+          med_diag%IBEN_SI%dgsave = .TRUE.
+      ELSE 
+          med_diag%IBEN_SI%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("IBEN_CA")) THEN 
+          med_diag%IBEN_CA%dgsave = .TRUE.
+      ELSE 
+          med_diag%IBEN_CA%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OBEN_N")) THEN 
+          med_diag%OBEN_N%dgsave = .TRUE.
+      ELSE 
+          med_diag%OBEN_N%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OBEN_FE")) THEN 
+          med_diag%OBEN_FE%dgsave = .TRUE.
+      ELSE 
+          med_diag%OBEN_FE%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OBEN_C")) THEN 
+          med_diag%OBEN_C%dgsave = .TRUE.
+      ELSE 
+          med_diag%OBEN_C%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OBEN_SI")) THEN 
+          med_diag%OBEN_SI%dgsave = .TRUE.
+      ELSE 
+          med_diag%OBEN_SI%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OBEN_CA")) THEN 
+          med_diag%OBEN_CA%dgsave = .TRUE.
+      ELSE 
+          med_diag%OBEN_CA%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("BEN_N")) THEN 
+          med_diag%BEN_N%dgsave = .TRUE.
+      ELSE 
+          med_diag%BEN_N%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("BEN_FE")) THEN 
+          med_diag%BEN_FE%dgsave = .TRUE.
+      ELSE 
+          med_diag%BEN_FE%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("BEN_C")) THEN 
+          med_diag%BEN_C%dgsave = .TRUE.
+      ELSE 
+          med_diag%BEN_C%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("BEN_SI")) THEN 
+          med_diag%BEN_SI%dgsave = .TRUE.
+      ELSE 
+          med_diag%BEN_SI%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("BEN_CA")) THEN 
+          med_diag%BEN_CA%dgsave = .TRUE.
+      ELSE 
+          med_diag%BEN_CA%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("RUNOFF")) THEN 
+          med_diag%RUNOFF%dgsave = .TRUE.
+      ELSE 
+          med_diag%RUNOFF%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("RIV_N")) THEN 
+          med_diag%RIV_N%dgsave = .TRUE.
+      ELSE 
+          med_diag%RIV_N%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("RIV_SI")) THEN 
+          med_diag%RIV_SI%dgsave = .TRUE.
+      ELSE 
+          med_diag%RIV_SI%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("RIV_C")) THEN 
+          med_diag%RIV_C%dgsave = .TRUE.
+      ELSE 
+          med_diag%RIV_C%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("RIV_ALK")) THEN 
+          med_diag%RIV_ALK%dgsave = .TRUE.
+      ELSE 
+          med_diag%RIV_ALK%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("DETC")) THEN 
+          med_diag%DETC%dgsave = .TRUE.
+      ELSE 
+          med_diag%DETC%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("SDC__100")) THEN 
+          med_diag%SDC__100%dgsave = .TRUE.
+      ELSE 
+          med_diag%SDC__100%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("SDC__200")) THEN 
+          med_diag%SDC__200%dgsave = .TRUE.
+      ELSE 
+          med_diag%SDC__200%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("SDC__500")) THEN 
+          med_diag%SDC__500%dgsave = .TRUE.
+      ELSE 
+          med_diag%SDC__500%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("SDC_1000")) THEN 
+          med_diag%SDC_1000%dgsave = .TRUE.
+      ELSE 
+          med_diag%SDC_1000%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INVTC")) THEN 
+          med_diag%INVTC%dgsave = .TRUE.
+      ELSE 
+          med_diag%INVTC%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INVTALK")) THEN 
+          med_diag%INVTALK%dgsave = .TRUE.
+      ELSE 
+          med_diag%INVTALK%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INVTO2")) THEN 
+          med_diag%INVTO2%dgsave = .TRUE.
+      ELSE 
+          med_diag%INVTO2%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("LYSO_CA")) THEN 
+          med_diag%LYSO_CA%dgsave = .TRUE.
+      ELSE 
+          med_diag%LYSO_CA%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("COM_RESP")) THEN 
+          med_diag%COM_RESP%dgsave = .TRUE.
+      ELSE 
+          med_diag%COM_RESP%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PN_LLOSS")) THEN 
+          med_diag%PN_LLOSS%dgsave = .TRUE.
+      ELSE 
+          med_diag%PN_LLOSS%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PD_LLOSS")) THEN 
+          med_diag%PD_LLOSS%dgsave = .TRUE.
+      ELSE 
+          med_diag%PD_LLOSS%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZI_LLOSS")) THEN 
+          med_diag%ZI_LLOSS%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZI_LLOSS%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZE_LLOSS")) THEN 
+          med_diag%ZE_LLOSS%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZE_LLOSS%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZI_MES_N")) THEN 
+          med_diag%ZI_MES_N%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZI_MES_N%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZI_MES_D")) THEN 
+          med_diag%ZI_MES_D%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZI_MES_D%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZI_MES_C")) THEN 
+          med_diag%ZI_MES_C%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZI_MES_C%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZI_MESDC")) THEN 
+          med_diag%ZI_MESDC%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZI_MESDC%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZI_EXCR")) THEN 
+          med_diag%ZI_EXCR%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZI_EXCR%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZI_RESP")) THEN 
+          med_diag%ZI_RESP%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZI_RESP%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZI_GROW")) THEN 
+          med_diag%ZI_GROW%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZI_GROW%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZE_MES_N")) THEN 
+          med_diag%ZE_MES_N%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZE_MES_N%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZE_MES_D")) THEN 
+          med_diag%ZE_MES_D%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZE_MES_D%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZE_MES_C")) THEN 
+          med_diag%ZE_MES_C%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZE_MES_C%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZE_MESDC")) THEN 
+          med_diag%ZE_MESDC%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZE_MESDC%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZE_EXCR")) THEN 
+          med_diag%ZE_EXCR%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZE_EXCR%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZE_RESP")) THEN 
+          med_diag%ZE_RESP%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZE_RESP%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZE_GROW")) THEN 
+          med_diag%ZE_GROW%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZE_GROW%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("MDETC")) THEN 
+          med_diag%MDETC%dgsave = .TRUE.
+      ELSE 
+          med_diag%MDETC%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("GMIDC")) THEN 
+          med_diag%GMIDC%dgsave = .TRUE.
+      ELSE 
+          med_diag%GMIDC%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("GMEDC")) THEN 
+          med_diag%GMEDC%dgsave = .TRUE.
+      ELSE 
+          med_diag%GMEDC%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INT_ZMI")) THEN 
+          med_diag%INT_ZMI%dgsave = .TRUE.
+      ELSE 
+          med_diag%INT_ZMI%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INT_ZME")) THEN 
+          med_diag%INT_ZME%dgsave = .TRUE.
+      ELSE 
+          med_diag%INT_ZME%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INT_DET")) THEN 
+          med_diag%INT_DET%dgsave = .TRUE.
+      ELSE 
+          med_diag%INT_DET%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INT_DTC")) THEN 
+          med_diag%INT_DTC%dgsave = .TRUE.
+      ELSE 
+          med_diag%INT_DTC%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("DMS_SURF")) THEN 
+          med_diag%DMS_SURF%dgsave = .TRUE.
+      ELSE 
+          med_diag%DMS_SURF%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("DMS_ANDR")) THEN 
+          med_diag%DMS_ANDR%dgsave = .TRUE.
+      ELSE 
+          med_diag%DMS_ANDR%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("DMS_SIMO")) THEN 
+          med_diag%DMS_SIMO%dgsave = .TRUE.
+      ELSE 
+          med_diag%DMS_SIMO%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("DMS_ARAN")) THEN 
+          med_diag%DMS_ARAN%dgsave = .TRUE.
+      ELSE 
+          med_diag%DMS_ARAN%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("DMS_HALL")) THEN 
+          med_diag%DMS_HALL%dgsave = .TRUE.
+      ELSE 
+          med_diag%DMS_HALL%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("DMS_ANDM")) THEN 
+          med_diag%DMS_ANDM%dgsave = .TRUE.
+      ELSE 
+          med_diag%DMS_ANDM%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ATM_XCO2")) THEN 
+          med_diag%ATM_XCO2%dgsave = .TRUE.
+      ELSE 
+          med_diag%ATM_XCO2%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OCN_FCO2")) THEN 
+          med_diag%OCN_FCO2%dgsave = .TRUE.
+      ELSE 
+          med_diag%OCN_FCO2%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ATM_FCO2")) THEN 
+          med_diag%ATM_FCO2%dgsave = .TRUE.
+      ELSE 
+          med_diag%ATM_FCO2%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OCN_RHOSW")) THEN 
+          med_diag%OCN_RHOSW%dgsave = .TRUE.
+      ELSE 
+          med_diag%OCN_RHOSW%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OCN_SCHCO2")) THEN 
+          med_diag%OCN_SCHCO2%dgsave = .TRUE.
+      ELSE 
+          med_diag%OCN_SCHCO2%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OCN_KWCO2")) THEN 
+          med_diag%OCN_KWCO2%dgsave = .TRUE.
+      ELSE 
+          med_diag%OCN_KWCO2%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OCN_K0")) THEN 
+          med_diag%OCN_K0%dgsave = .TRUE.
+      ELSE 
+          med_diag%OCN_K0%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("CO2STARAIR")) THEN 
+          med_diag%CO2STARAIR%dgsave = .TRUE.
+      ELSE 
+          med_diag%CO2STARAIR%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OCN_DPCO2")) THEN 
+          med_diag%OCN_DPCO2%dgsave = .TRUE.
+      ELSE 
+          med_diag%OCN_DPCO2%dgsave = .FALSE.
+      ENDIF
+      !!
+      IF  (iom_use("TPP3")) THEN 
+          med_diag%TPP3%dgsave = .TRUE.
+      ELSE 
+          med_diag%TPP3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("DETFLUX3")) THEN 
+          med_diag%DETFLUX3%dgsave = .TRUE.
+      ELSE 
+          med_diag%DETFLUX3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("REMIN3N")) THEN 
+          med_diag%REMIN3N%dgsave = .TRUE.
+      ELSE 
+          med_diag%REMIN3N%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PH3")) THEN 
+          med_diag%PH3%dgsave = .TRUE.
+      ELSE 
+          med_diag%PH3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("OM_CAL3")) THEN 
+          med_diag%OM_CAL3%dgsave = .TRUE.
+      ELSE 
+          med_diag%OM_CAL3%dgsave = .FALSE.
+      ENDIF
+      !!
+      !!----------------------------------------------------------------------
+      !! AXY (03/11/16): add in additional CMIP6 diagnostics
+      !!----------------------------------------------------------------------
+      !!
+      !! 2D fields
+      IF  (iom_use("epC100")) THEN 
+          med_diag%epC100%dgsave = .TRUE.
+      ELSE 
+          med_diag%epC100%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("epCALC100")) THEN 
+          med_diag%epCALC100%dgsave = .TRUE.
+      ELSE 
+          med_diag%epCALC100%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("epN100")) THEN 
+          med_diag%epN100%dgsave = .TRUE.
+      ELSE 
+          med_diag%epN100%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("epSI100")) THEN 
+          med_diag%epSI100%dgsave = .TRUE.
+      ELSE 
+          med_diag%epSI100%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FGCO2")) THEN 
+          med_diag%FGCO2%dgsave = .TRUE.
+      ELSE 
+          med_diag%FGCO2%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INTDISSIC")) THEN 
+          med_diag%INTDISSIC%dgsave = .TRUE.
+      ELSE 
+          med_diag%INTDISSIC%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INTDISSIN")) THEN 
+          med_diag%INTDISSIN%dgsave = .TRUE.
+      ELSE 
+          med_diag%INTDISSIN%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INTDISSISI")) THEN 
+          med_diag%INTDISSISI%dgsave = .TRUE.
+      ELSE 
+          med_diag%INTDISSISI%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("INTTALK")) THEN 
+          med_diag%INTTALK%dgsave = .TRUE.
+      ELSE 
+          med_diag%INTTALK%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("O2min")) THEN 
+          med_diag%O2min%dgsave = .TRUE.
+      ELSE 
+          med_diag%O2min%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("ZO2min")) THEN 
+          med_diag%ZO2min%dgsave = .TRUE.
+      ELSE 
+          med_diag%ZO2min%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FBDDTALK")) THEN 
+          med_diag%FBDDTALK%dgsave = .TRUE.
+      ELSE 
+          med_diag%FBDDTALK%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FBDDTDIC")) THEN 
+          med_diag%FBDDTDIC%dgsave = .TRUE.
+      ELSE 
+          med_diag%FBDDTDIC%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FBDDTDIFE")) THEN 
+          med_diag%FBDDTDIFE%dgsave = .TRUE.
+      ELSE 
+          med_diag%FBDDTDIFE%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FBDDTDIN")) THEN 
+          med_diag%FBDDTDIN%dgsave = .TRUE.
+      ELSE 
+          med_diag%FBDDTDIN%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FBDDTDISI")) THEN 
+          med_diag%FBDDTDISI%dgsave = .TRUE.
+      ELSE 
+          med_diag%FBDDTDISI%dgsave = .FALSE.
+      ENDIF
+      !!
+      !! 3D
+      IF  (iom_use("TPPD3")) THEN 
+          med_diag%TPPD3%dgsave = .TRUE.
+      ELSE 
+          med_diag%TPPD3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("BDDTALK3")) THEN 
+          med_diag%BDDTALK3%dgsave = .TRUE.
+      ELSE 
+          med_diag%BDDTALK3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("BDDTDIC3")) THEN 
+          med_diag%BDDTDIC3%dgsave = .TRUE.
+      ELSE 
+          med_diag%BDDTDIC3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("BDDTDIFE3")) THEN 
+          med_diag%BDDTDIFE3%dgsave = .TRUE.
+      ELSE 
+          med_diag%BDDTDIFE3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("BDDTDIN3")) THEN 
+          med_diag%BDDTDIN3%dgsave = .TRUE.
+      ELSE 
+          med_diag%BDDTDIN3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("BDDTDISI3")) THEN 
+          med_diag%BDDTDISI3%dgsave = .TRUE.
+      ELSE 
+          med_diag%BDDTDISI3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FD_NIT3")) THEN 
+          med_diag%FD_NIT3%dgsave = .TRUE.
+      ELSE 
+          med_diag%FD_NIT3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FD_SIL3")) THEN 
+          med_diag%FD_SIL3%dgsave = .TRUE.
+      ELSE 
+          med_diag%FD_SIL3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FD_CAR3")) THEN 
+          med_diag%FD_CAR3%dgsave = .TRUE.
+      ELSE 
+          med_diag%FD_CAR3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FD_CAL3")) THEN 
+          med_diag%FD_CAL3%dgsave = .TRUE.
+      ELSE 
+          med_diag%FD_CAL3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("CO33")) THEN 
+          med_diag%CO33%dgsave = .TRUE.
+      ELSE 
+          med_diag%CO33%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("CO3SATARAG3")) THEN 
+          med_diag%CO3SATARAG3%dgsave = .TRUE.
+      ELSE 
+          med_diag%CO3SATARAG3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("CO3SATCALC3")) THEN 
+          med_diag%CO3SATCALC3%dgsave = .TRUE.
+      ELSE 
+          med_diag%CO3SATCALC3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("DCALC3")) THEN 
+          med_diag%DCALC3%dgsave = .TRUE.
+      ELSE 
+          med_diag%DCALC3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("EXPC3")) THEN 
+          med_diag%EXPC3%dgsave = .TRUE.
+      ELSE 
+          med_diag%EXPC3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("EXPN3")) THEN 
+          med_diag%EXPN3%dgsave = .TRUE.
+      ELSE 
+          med_diag%EXPN3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FEDISS3")) THEN 
+          med_diag%FEDISS3%dgsave = .TRUE.
+      ELSE 
+          med_diag%FEDISS3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("FESCAV3")) THEN 
+          med_diag%FESCAV3%dgsave = .TRUE.
+      ELSE 
+          med_diag%FESCAV3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("MIGRAZP3")) THEN 
+          med_diag%MIGRAZP3%dgsave = .TRUE.
+      ELSE 
+          med_diag%MIGRAZP3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("MIGRAZD3")) THEN 
+          med_diag%MIGRAZD3%dgsave = .TRUE.
+      ELSE 
+          med_diag%MIGRAZD3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("MEGRAZP3")) THEN 
+          med_diag%MEGRAZP3%dgsave = .TRUE.
+      ELSE 
+          med_diag%MEGRAZP3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("MEGRAZD3")) THEN 
+          med_diag%MEGRAZD3%dgsave = .TRUE.
+      ELSE 
+          med_diag%MEGRAZD3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("MEGRAZZ3")) THEN 
+          med_diag%MEGRAZZ3%dgsave = .TRUE.
+      ELSE 
+          med_diag%MEGRAZZ3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("O2SAT3")) THEN 
+          med_diag%O2SAT3%dgsave = .TRUE.
+      ELSE 
+          med_diag%O2SAT3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PBSI3")) THEN 
+          med_diag%PBSI3%dgsave = .TRUE.
+      ELSE 
+          med_diag%PBSI3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PCAL3")) THEN 
+          med_diag%PCAL3%dgsave = .TRUE.
+      ELSE 
+          med_diag%PCAL3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("REMOC3")) THEN 
+          med_diag%REMOC3%dgsave = .TRUE.
+      ELSE 
+          med_diag%REMOC3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PNLIMJ3")) THEN 
+          med_diag%PNLIMJ3%dgsave = .TRUE.
+      ELSE 
+          med_diag%PNLIMJ3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PNLIMN3")) THEN 
+          med_diag%PNLIMN3%dgsave = .TRUE.
+      ELSE 
+          med_diag%PNLIMN3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PNLIMFE3")) THEN 
+          med_diag%PNLIMFE3%dgsave = .TRUE.
+      ELSE 
+          med_diag%PNLIMFE3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PDLIMJ3")) THEN 
+          med_diag%PDLIMJ3%dgsave = .TRUE.
+      ELSE 
+          med_diag%PDLIMJ3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PDLIMN3")) THEN 
+          med_diag%PDLIMN3%dgsave = .TRUE.
+      ELSE 
+          med_diag%PDLIMN3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PDLIMFE3")) THEN 
+          med_diag%PDLIMFE3%dgsave = .TRUE.
+      ELSE 
+          med_diag%PDLIMFE3%dgsave = .FALSE.
+      ENDIF
+      IF  (iom_use("PDLIMSI3")) THEN 
+          med_diag%PDLIMSI3%dgsave = .TRUE.
+      ELSE 
+          med_diag%PDLIMSI3%dgsave = .FALSE.
+      ENDIF
+
+   END SUBROUTINE   trc_nam_iom_medusa
+   
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                             No MEDUSA
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_nam_medusa                      ! Empty routine
+   END  SUBROUTINE  trc_nam_medusa
+#endif  
+
+   !!======================================================================
+END MODULE trcnam_medusa
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcopt_medusa.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcopt_medusa.F90	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcopt_medusa.F90	(revision 8201)
@@ -0,0 +1,187 @@
+MODULE trcopt_medusa
+   !!======================================================================
+   !!                         ***  MODULE trcopt_medusa  ***
+   !! TOP :   MEDUSA Compute the light availability in the water column
+   !!======================================================================
+   !! History :    -   !  1995-05  (M. Levy) Original code
+   !!              -   !  1999-09  (J.-M. Andre, M. Levy) 
+   !!              -   !  1999-11  (C. Menkes, M.-A. Foujols) itabe initial
+   !!              -   !  2000-02  (M.A. Foujols) change x**y par exp(y*log(x))
+   !!             2.0  !  2007-12  (C. Deltel, G. Madec)  F90
+   !!              -   !  2008-08  (K. Popova) adaptation for MEDUSA
+   !!              -   !  2008-11  (A. Yool) continuing adaptation for MEDUSA
+   !!              -   !  2010-03  (A. Yool) updated for branch inclusion
+   !!----------------------------------------------------------------------
+#if defined key_medusa
+   !!----------------------------------------------------------------------
+   !!   'key_medusa'                                      MEDUSA bio-model
+   !!----------------------------------------------------------------------
+   !!   trc_opt_medusa        :   Compute the light availability in the water column
+   !!----------------------------------------------------------------------
+   USE oce_trc         !
+   USE trc
+   USE prtctl_trc      ! Print control for debbuging
+   USE sms_medusa
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_opt_medusa   ! called in trcprg.F90
+
+   !!* Substitution
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_opt_medusa( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_opt_medusa  ***
+      !!
+      !! ** Purpose :   computes the light propagation in the water column
+      !!              and the euphotic layer depth
+      !!
+      !! ** Method  :   local par is computed in w layers using light propagation
+      !!              mean par in t layers are computed by integration
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt   ! index of the time stepping
+      INTEGER  ::   ji, jj, jk
+      REAL(wp) ::   zpig                                    ! total pigment
+      REAL(wp) ::   zkr                                     ! total absorption coefficient in red
+      REAL(wp) ::   zkg                                     ! total absorption coefficient in green
+      REAL(wp) ::   totchl                                  ! total Chl concentreation
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zpar100         ! irradiance at euphotic layer depth
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zpar0m          ! irradiance just below the surface
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zparr, zparg    ! red and green compound of par
+
+      CHARACTER (len=25) :: charout
+      !!---------------------------------------------------------------------
+
+      !! AXY (20/11/14): alter this to report on first MEDUSA call
+      !! IF( kt == nit000 ) THEN
+      IF( kt == nittrc000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' trc_opt_medusa: MEDUSA optic-model'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~'
+	 IF(lwp) WRITE(numout,*) ' kt =',kt
+      ENDIF
+
+      ! determination of surface irradiance
+      ! -----------------------------------
+      ! AXY (23/07/15): the inclusion of empirical DMS calculations requires
+      !                 daily averages of a series of properties that are
+      !                 used as inputs; these include surface irradiance; 
+      !                 here, this is taken advantage of to allow MEDUSA to
+      !                 base its submarine light field on daily average
+      !                 rather than "instantaneous" irradiance; largely
+      !                 because MEDUSA was originally formulated to work
+      !                 with diel average irradiance rather than a diel
+      !                 cycle; using key_avgqsr_medusa activates this
+      !                 functionality, while its absence gives default
+      !                 MEDUSA (which is whatever is supplied by NEMO)
+# if defined key_avgqsr_medusa
+      ! surface irradiance input is rolling average irradiance
+      zpar0m (:,:)   = zn_dms_qsr(:,:) * 0.43
+# else      
+      ! surface irradiance input is   instantaneous irradiance
+      zpar0m (:,:)   =        qsr(:,:) * 0.43
+# endif
+      ! AXY (22/08/14): when zpar0m = 0, zpar100 is also zero and calculating 
+      !                 euphotic depth is not possible (cf. the Arctic Octopus); 
+      !                 a "solution" to this is to set zpar0m to some minimal
+      !                 value such that zpar100 also has a non-zero value and
+      !                 euphotic depth can be calculated properly; note that,
+      !                 in older, non-diurnal versions of NEMO, this was much
+      !                 less of a problem; note also that, if pushed, I will
+      !                 claim that my minimal value of zpar0m refers to light
+      !                 from stars
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( zpar0m(ji,jj) <= 0.0 ) zpar0m(ji,jj) = 0.001  ! = 1 mW/m2
+         ENDDO
+      ENDDO
+      zpar100(:,:)   = zpar0m(:,:) * 0.01
+      xpar   (:,:,1) = zpar0m(:,:)
+      zparr  (:,:,1) = 0.5 * zpar0m(:,:)
+      zparg  (:,:,1) = 0.5 * zpar0m(:,:)
+
+      ! determination of xpar
+      ! ---------------------
+
+      DO jk = 2, jpk                     ! determination of local par in w levels
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               totchl =trn(ji,jj,jk-1,jpchn)+trn(ji,jj,jk-1,jpchd)
+               zpig = MAX( TINY(0.), totchl/rpig) 
+               zkr  = xkr0 + xkrp * EXP( xlr * LOG( zpig ) )
+               zkg  = xkg0 + xkgp * EXP( xlg * LOG( zpig ) )
+               zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * fse3t(ji,jj,jk-1) )
+               zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * fse3t(ji,jj,jk-1) )
+            END DO
+        END DO
+      END DO
+
+      DO jk = 1, jpkm1                   ! mean par in t levels
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               totchl =trn(ji,jj,jk  ,jpchn)+trn(ji,jj,jk  ,jpchd)
+               zpig = MAX( TINY(0.), totchl/rpig) 
+               zkr  = xkr0 + xkrp * EXP( xlr * LOG( zpig ) )
+               zkg  = xkg0 + xkgp * EXP( xlg * LOG( zpig ) )
+               zparr(ji,jj,jk)    = zparr(ji,jj,jk) / zkr / fse3t(ji,jj,jk) * ( 1 - EXP( -zkr*fse3t(ji,jj,jk) ) )
+               zparg(ji,jj,jk)    = zparg(ji,jj,jk) / zkg / fse3t(ji,jj,jk) * ( 1 - EXP( -zkg*fse3t(ji,jj,jk) ) )
+               xpar (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 )
+            END DO
+         END DO
+      END DO
+
+      ! 3. Determination of euphotic layer depth
+      ! ----------------------------------------
+
+      ! Euphotic layer bottom level
+      neln(:,:) = 1                                           ! initialisation of EL level
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+           DO ji = 1, jpi
+              IF( xpar(ji,jj,jk) >= zpar100(ji,jj) )   neln(ji,jj) = jk+1 ! 1rst T-level strictly below EL bottom
+              !                                                  ! nb. this is to ensure compatibility with
+              !                                                  ! nmld_trc definition in trd_mld_trc_zint
+           END DO
+         END DO
+      ENDDO
+
+      ! Euphotic layer depth
+      !! Jpalm -- 06-03-2017 -- add init xze, to avoid halo problems within the
+      !!                        writing process
+      xze(:,:) = 0.0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            xze(ji,jj) = fsdepw( ji, jj, neln(ji,jj) )            ! exact EL depth
+         END DO
+      ENDDO 
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('opt')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm )
+      ENDIF
+
+   END SUBROUTINE trc_opt_medusa
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No MEDUSA bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE trc_opt_medusa( kt )                   ! Empty routine
+      INTEGER, INTENT( in ) ::   kt
+      WRITE(*,*) 'trc_opt_medusa: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_opt_medusa
+#endif 
+
+   !!======================================================================
+END MODULE  trcopt_medusa
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcoxy_medusa.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcoxy_medusa.F90	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcoxy_medusa.F90	(revision 8201)
@@ -0,0 +1,280 @@
+MODULE trcoxy_medusa
+   !!======================================================================
+   !!                         ***  MODULE trcoxy_medusa  ***
+   !! TOP :   MEDUSA
+   !!======================================================================
+   !! History :
+   !!  -   !  2011-07  (A. Yool)             added for ROAM project
+   !!----------------------------------------------------------------------
+#if defined key_medusa && defined key_roam
+   !!----------------------------------------------------------------------
+   !!                                        MEDUSA oxygen cycle
+   !!----------------------------------------------------------------------
+   !!   trc_oxy_medusa        :  
+   !!----------------------------------------------------------------------
+      USE oce_trc
+      USE trc
+      USE sms_medusa
+      USE lbclnk
+      USE prtctl_trc      ! Print control for debugging
+
+      IMPLICIT NONE
+      PRIVATE
+      
+      PUBLIC   trc_oxy_medusa    ! called in trc_bio_medusa
+      PUBLIC   oxy_sato          ! called in trc_bio_medusa
+
+   !!* Substitution
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+! The following is a map of the subroutines contained within this module
+! - trc_oxy_medusa
+!      - CALLS oxy_schmidt
+!      - CALLS oxy_sato
+
+CONTAINS
+
+!=======================================================================
+!
+   SUBROUTINE trc_oxy_medusa( pt, ps, kw660, pp0, o2,  &  !! inputs
+      kwo2, o2flux, o2sat )                               !! outputs
+!      
+!=======================================================================
+      !!
+      !! Title  : Calculates O2 change due to air-sea gas exchange
+      !! Author : Andrew Yool
+      !! Date   : 15/10/04 (revised 08/07/11)
+      !!
+      !! This subroutine calculates oxygen air-sea gas exchange in the
+      !! surface layer of the ocean.  The formulation is taken from one 
+      !! written by Ray Najjar for the OCMIP-2 project.  The routine
+      !! calls two other subroutines, oxy_schmidt.f (calculates Schmidt 
+      !! number of oxygen) and oxy_sato.f (calculates oxygen saturation 
+      !! concentration at 1 atm).
+      !!
+      !! AXY (23/06/15): revised to allow common gas transfer velocity
+      !!                 to be used for CO2 and O2; outputs of this
+      !!                 routine amended to mmol/m3 from mol/m3
+      !! 
+      !! Function inputs are (in order) : 
+      !!     pt      temperature                     (degrees C)
+      !!     ps      salinity                        (PSU)
+      !!     kw660   gas transfer velocity           (m/s)
+      !!     pp0     surface pressure                (divided by 1 atm)
+      !!     o2      surface O2 concentration        (mmol/m3)
+      !! (+) kwo2    gas transfer velocity for O2    (m/s)
+      !! (*) o2flux  exchange rate of oxygen         (mmol/m2/s)
+      !! (+) o2sat   oxygen saturation concentration (mmol/m3)
+      !! 
+      !! Where (*) is the function output (note its units).  
+      !!
+!=======================================================================
+
+      implicit none
+!
+      REAL(wp), INTENT( in )    :: pt
+      REAL(wp), INTENT( in )    :: ps
+      REAL(wp), INTENT( in )    :: kw660
+      REAL(wp), INTENT( in )    :: pp0
+      REAL(wp), INTENT( in )    :: o2
+      REAL(wp), INTENT( out )   :: kwo2, o2flux, o2sat
+!
+      REAL(wp) :: o2schmidt, o2sato, mol_o2
+!
+! Oxygen to mol / m3
+!
+      mol_o2 = o2 / 1000.
+!
+! Calculate oxygen Schmidt number
+! 
+      call oxy_schmidt(pt, o2schmidt)
+!
+! Calculate the transfer velocity for O2 (m/s)
+!
+      kwo2 = kw660 * (660 / o2schmidt)**0.5
+!
+! Calculate the saturation concentration for oxygen (mol/m3)
+!
+      call oxy_sato(pt, ps, o2sato)
+      o2sat = o2sato * pp0
+!
+! Calculate time rate of change of O2 due to gas exchange (mol/m3/s)
+!
+      o2flux = kwo2 * (o2sat - mol_o2)
+!
+! Oxygen flux and saturation to mmol / m3
+!
+      o2sat  =  o2sat * 1000.
+      o2flux = o2flux * 1000.
+!
+      END SUBROUTINE trc_oxy_medusa
+
+!=======================================================================
+!=======================================================================
+!=======================================================================
+
+!=======================================================================
+!
+   SUBROUTINE oxy_schmidt( pt, &  !! input
+      o2_schmidt )                !! output
+!      
+!=======================================================================
+      !!
+      !! Title  : Calculates Schmidt number for ocean uptake of O2
+      !! Author : Andrew Yool
+      !! Date   : 14/10/04 (revised 08/07/11)
+      !! 
+      !! This subroutine calculates the Schmidt number for O2 using sea 
+      !! surface temperature.  The code is based upon that developed as 
+      !! part of the OCMIP-2 project (1998-2000).  The coefficients used 
+      !! are taken from Keeling et al. (1998, GBC, 12, 141-163).
+      !! 
+      !! AXY (23/06/2015)
+      !! UPDATED: revised formulation from Wanninkhof (2014) for
+      !! consistency with MOCSY
+      !!
+      !! Winninkhof, R. (2014). Relationship between wind speed and gas
+      !! exchange over the ocean revisited. LIMNOLOGY AND OCEANOGRAPHY-METHODS
+      !! 12, 351-362, doi:10.4319/lom.2014.12.351
+      !!
+      !! Function inputs are (in order) : 
+      !!     t           temperature (degrees C)
+      !! (*) o2_schmidt  oxygen Schmidt number
+      !! 
+      !! Where (*) is the function output.
+      !!
+!=======================================================================
+
+      implicit none
+!
+      REAL(wp) :: pt, o2_schmidt
+      REAL(wp) :: a0, a1, a2, a3, a4
+!
+! AXY (23/06/15): OCMIP-2 coefficients
+!     data a0 /    1638.0 /
+!     data a1 /    -81.83 /
+!     data a2 /     1.483 /
+!     data a3 / -0.008004 /
+!
+! AXY (23/06/15): Wanninkhof (2014) coefficients
+      data a0 /     1920.4 /
+      data a1 /     -135.6 /
+      data a2 /     5.2121 /
+      data a3 /   -0.10939 /
+      data a4 / 0.00093777 /
+!
+!     o2_schmidt = a0 + pt*(a1 + pt*(a2 + pt*a3))
+      o2_schmidt = a0 + pt*(a1 + pt*(a2 + pt*(a3 + pt*a4)))
+!
+      END SUBROUTINE oxy_schmidt
+
+!=======================================================================
+!=======================================================================
+!=======================================================================
+
+!=======================================================================
+!
+   SUBROUTINE oxy_sato( pt, ps, &  !! inputs 
+      o2_sato )                    !! output
+!      
+!=======================================================================
+      !!
+      !! Title  : Calculates O2 saturation at 1 atm pressure
+      !! Author : Andrew Yool
+      !! Date   : 14/10/04 (revised 08/07/11)
+      !! 
+      !! This subroutine calculates the oxygen saturation concentration
+      !! at 1 atmosphere pressure in mol/m3 given ambient temperature
+      !! and salinity.  This formulation is (ostensibly) taken from 
+      !! Garcia & Gordon (1992, L&O, 1307-1312).  The function works
+      !! in the range -1.9 <= T <= 40, 0 <= S <= 42.
+      !!
+      !! Function inputs are (in order) : 
+      !!     pt       temperature (degrees C)
+      !!     ps       salinity (PSU)
+      !! (*) o2_sato  oxygen saturation (mol/m3)
+      !!
+      !! Where (*) is the function output (note its units).  
+      !!
+      !! Check value : T = 10, S = 35, oxy_sato = 0.282015 mol/m3
+      !!
+!=======================================================================
+
+      implicit none
+!
+      REAL(wp) :: pt, ps, o2_sato
+!
+      REAL(wp) :: a0, a1, a2, a3, a4, a5
+      REAL(wp) :: b0, b1, b2, b3
+      REAL(wp) :: c0
+!
+      REAL(wp) :: tt, tk, ts, ts2, ts3, ts4, ts5
+      REAL(wp) :: ans1, ans2
+!
+      data a0 /  2.00907    /
+      data a1 /  3.22014    /
+      data a2 /  4.05010    /
+      data a3 /  4.94457    /
+      data a4 / -2.56847E-1 /
+      data a5 /  3.88767    /
+!
+      data b0 / -6.24523E-3 /
+      data b1 / -7.37614E-3 /
+      data b2 / -1.03410E-2 /
+      data b3 / -8.17083E-3 /
+!
+      data c0 / -4.88682E-7 /
+!     
+      tt   = 298.15 - pt
+      tk   = 273.15 + pt
+      ts   = log(tt / tk)
+      ts2  = ts**2
+      ts3  = ts**3
+      ts4  = ts**4
+      ts5  = ts**5
+      ans1 = a0 + a1*ts + a2*ts2 + a3*ts3 + a4*ts4 + a5*ts5  &
+           + ps*(b0 + b1*ts + b2*ts2 + b3*ts3)               &
+           + c0*(ps*ps)
+      ans2 = exp(ans1)
+!
+!  Convert from ml/l to mol/m3
+!
+      o2_sato = (ans2 / 22391.6) * 1000.0
+!
+      END SUBROUTINE oxy_sato
+
+!=======================================================================
+!=======================================================================
+!=======================================================================
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No MEDUSA bio-model
+   !!======================================================================
+
+CONTAINS
+
+   SUBROUTINE trc_oxy_medusa( pt, ps, kw660, pp0, o2,  &  !! inputs
+      o2flux, o2sat )                                     !! outputs
+      USE par_kind
+
+      REAL(wp), INTENT( in )    :: pt
+      REAL(wp), INTENT( in )    :: ps
+      REAL(wp), INTENT( in )    :: kw660
+      REAL(wp), INTENT( in )    :: pp0
+      REAL(wp), INTENT( in )    :: o2
+      REAL(wp), INTENT( inout ) :: o2flux, o2sat
+
+      WRITE(*,*) 'trc_oxy_medusa: You should not have seen this print! error?', kt
+
+   END SUBROUTINE trc_oxy_medusa
+#endif
+
+   !!======================================================================
+END MODULE  trcoxy_medusa
+  
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcrst_medusa.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcrst_medusa.F90	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcrst_medusa.F90	(revision 8201)
@@ -0,0 +1,306 @@
+MODULE trcrst_medusa
+   !!======================================================================
+   !!                       ***  MODULE trcrst_medusa  ***
+   !! TOP :   create, write, read the restart files of MEDUSA tracer
+   !!======================================================================
+   !! History :   1.0  !  2010-01 (C. Ethe) Original
+   !!             1.1  !  2014-07 (A. Yool; J. Palmieri) converted for MEDUSA
+   !!             1.2  !  2015-07 (A. Yool) add averaged fields for DMS
+   !!----------------------------------------------------------------------
+#if defined key_medusa
+   !!----------------------------------------------------------------------
+   !!   'key_medusa'                                               medusa tracers
+   !!----------------------------------------------------------------------
+   !!   trc_rst_read_medusa   : read  restart file
+   !!   trc_rst_wri_medusa    : write restart file
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! Ocean variables
+   USE par_trc         ! TOP parameters
+   USE trc             ! TOP variables
+   USE trcsms_medusa   ! MEDUSA sms trends
+   USE sms_medusa      ! MEDUSA sms trends
+   USE iom
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC  trc_rst_read_medusa  ! called by trcini.F90 module (actually trcrst.F90)
+   PUBLIC  trc_rst_wri_medusa   ! called by trcini.F90 module (actually trcrst.F90)
+
+CONTAINS
+   
+   SUBROUTINE trc_rst_read_medusa( knum ) 
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_rst_read_medusa  ***  
+      !!
+      !! ** Purpose : Read in restart file specific variables from medusa model
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in)  :: knum  ! unit of the restart file
+      !! AXY (07/07/14): temporary variables
+      REAL(wp) ::    fq0,fq1,fq2
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_rst_read_medusa : Read specific variables from medusa model '
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+
+      !! AXY (07/07/14): remove LOBSTER calls
+      !! CALL iom_get( knum, jpdom_autoglo, 'SEDB'//ctrcnm(jp_lob_det), sedpocb(:,:) ) 
+      !! CALL iom_get( knum, jpdom_autoglo, 'SEDN'//ctrcnm(jp_lob_det), sedpocn(:,:) ) 
+
+      !! AXY (07/07/14): as well as passive tracers, the restart files
+      !!                 contain 2D fields of sediments; these need to
+      !!                 be read in specially; hence this routine
+      !!
+      !! AXY (13/01/12): check if the restart contains sediment fields;
+      !!                 this is only relevant for simulations that include
+      !!                 biogeochemistry and are restarted from earlier runs
+      !!                 in which there was no sediment component
+      !!
+      IF( iom_varid( knum, 'B_SED_N', ldstop = .FALSE. ) > 0 ) THEN
+         !! YES; in which case read them
+         !!
+         IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields present - reading in ...'
+         CALL iom_get( knum, jpdom_autoglo, 'B_SED_N',  zb_sed_n(:,:)  )
+         CALL iom_get( knum, jpdom_autoglo, 'N_SED_N',  zn_sed_n(:,:)  )
+         CALL iom_get( knum, jpdom_autoglo, 'B_SED_FE', zb_sed_fe(:,:) )
+         CALL iom_get( knum, jpdom_autoglo, 'N_SED_FE', zn_sed_fe(:,:) )
+         CALL iom_get( knum, jpdom_autoglo, 'B_SED_SI', zb_sed_si(:,:) )
+         CALL iom_get( knum, jpdom_autoglo, 'N_SED_SI', zn_sed_si(:,:) )
+         CALL iom_get( knum, jpdom_autoglo, 'B_SED_C',  zb_sed_c(:,:)  )
+         CALL iom_get( knum, jpdom_autoglo, 'N_SED_C',  zn_sed_c(:,:)  )
+         CALL iom_get( knum, jpdom_autoglo, 'B_SED_CA', zb_sed_ca(:,:) )
+         CALL iom_get( knum, jpdom_autoglo, 'N_SED_CA', zn_sed_ca(:,:) )
+      ELSE
+         !! NO; in which case set them to zero
+         !!
+         IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields absent - setting to zero ...'
+         zb_sed_n(:,:)  = 0.0   !! organic N
+         zn_sed_n(:,:)  = 0.0
+         zb_sed_fe(:,:) = 0.0   !! organic Fe
+         zn_sed_fe(:,:) = 0.0
+         zb_sed_si(:,:) = 0.0   !! inorganic Si
+         zn_sed_si(:,:) = 0.0
+         zb_sed_c(:,:)  = 0.0   !! organic C
+         zn_sed_c(:,:)  = 0.0
+         zb_sed_ca(:,:) = 0.0   !! inorganic C
+         zn_sed_ca(:,:) = 0.0
+      ENDIF
+      !!
+      !! calculate stats on these fields
+      IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...'
+      fq0 = MINVAL(zn_sed_n(:,:))
+      fq1 = MAXVAL(zn_sed_n(:,:))
+      fq2 = SUM(zn_sed_n(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'Sediment  N ', &
+         &        fq0, fq1, fq2
+      fq0 = MINVAL(zn_sed_fe(:,:))
+      fq1 = MAXVAL(zn_sed_fe(:,:))
+      fq2 = SUM(zn_sed_fe(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'Sediment Fe ', &
+         &        fq0, fq1, fq2
+      fq0 = MINVAL(zn_sed_si(:,:))
+      fq1 = MAXVAL(zn_sed_si(:,:))
+      fq2 = SUM(zn_sed_si(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'Sediment Si ', &
+         &        fq0, fq1, fq2
+      fq0 = MINVAL(zn_sed_c(:,:))
+      fq1 = MAXVAL(zn_sed_c(:,:))
+      fq2 = SUM(zn_sed_c(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'Sediment  C ', &
+         &        fq0, fq1, fq2
+      fq0 = MINVAL(zn_sed_ca(:,:))
+      fq1 = MAXVAL(zn_sed_ca(:,:))
+      fq2 = SUM(zn_sed_ca(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'Sediment Ca ', &
+         &        fq0, fq1, fq2
+
+      !! AXY (07/07/15): read in temporally averaged fields for DMS
+      !!                 calculations
+      !!
+      IF( iom_varid( knum, 'B_DMS_CHN', ldstop = .FALSE. ) > 0 ) THEN
+         !! YES; in which case read them
+         !!
+         IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS present - reading in ...'
+         CALL iom_get( knum, jpdom_autoglo, 'B_DMS_CHN',  zb_dms_chn(:,:)  )
+         CALL iom_get( knum, jpdom_autoglo, 'N_DMS_CHN',  zn_dms_chn(:,:)  )
+         CALL iom_get( knum, jpdom_autoglo, 'B_DMS_CHD',  zb_dms_chd(:,:)  )
+         CALL iom_get( knum, jpdom_autoglo, 'N_DMS_CHD',  zn_dms_chd(:,:)  )
+         CALL iom_get( knum, jpdom_autoglo, 'B_DMS_MLD',  zb_dms_mld(:,:)  )
+         CALL iom_get( knum, jpdom_autoglo, 'N_DMS_MLD',  zn_dms_mld(:,:)  )
+         CALL iom_get( knum, jpdom_autoglo, 'B_DMS_QSR',  zb_dms_qsr(:,:)  )
+         CALL iom_get( knum, jpdom_autoglo, 'N_DMS_QSR',  zn_dms_qsr(:,:)  )
+         CALL iom_get( knum, jpdom_autoglo, 'B_DMS_DIN',  zb_dms_din(:,:)  )
+         CALL iom_get( knum, jpdom_autoglo, 'N_DMS_DIN',  zn_dms_din(:,:)  )
+      ELSE
+         !! NO; in which case set them to zero
+         !!
+         IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS absent - setting to zero ...'
+         zb_dms_chn(:,:)  = 0.0   !! CHN
+         zn_dms_chn(:,:)  = 0.0
+         zb_dms_chd(:,:)  = 0.0   !! CHD
+         zn_dms_chd(:,:)  = 0.0
+         zb_dms_mld(:,:)  = 0.0   !! MLD
+         zn_dms_mld(:,:)  = 0.0
+         zb_dms_qsr(:,:)  = 0.0   !! QSR
+         zn_dms_qsr(:,:)  = 0.0
+         zb_dms_din(:,:)  = 0.0   !! DIN
+         zn_dms_din(:,:)  = 0.0
+      ENDIF
+      !!
+      !! calculate stats on these fields
+      IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS stats (min, max, sum) ...'
+      fq0 = MINVAL(zn_dms_chn(:,:))
+      fq1 = MAXVAL(zn_dms_chn(:,:))
+      fq2 = SUM(zn_dms_chn(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'DMS, CHN ', fq0, fq1, fq2
+      fq0 = MINVAL(zn_dms_chd(:,:))
+      fq1 = MAXVAL(zn_dms_chd(:,:))
+      fq2 = SUM(zn_dms_chd(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'DMS, CHD ', fq0, fq1, fq2
+      fq0 = MINVAL(zn_dms_mld(:,:))
+      fq1 = MAXVAL(zn_dms_mld(:,:))
+      fq2 = SUM(zn_dms_mld(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'DMS, MLD ', fq0, fq1, fq2
+      fq0 = MINVAL(zn_dms_qsr(:,:))
+      fq1 = MAXVAL(zn_dms_qsr(:,:))
+      fq2 = SUM(zn_dms_qsr(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'DMS, QSR ', fq0, fq1, fq2
+      fq0 = MINVAL(zn_dms_din(:,:))
+      fq1 = MAXVAL(zn_dms_din(:,:))
+      fq2 = SUM(zn_dms_din(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'DMS, DIN ', fq0, fq1, fq2
+
+   END SUBROUTINE trc_rst_read_medusa
+
+   SUBROUTINE trc_rst_wri_medusa( kt, kitrst, knum )
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_rst_read_medusa  ***
+      !!
+      !! ** Purpose : Read in restart file specific variables from medusa model
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in)  :: kt      ! time step
+      INTEGER, INTENT(in)  :: kitrst  ! time step of restart write
+      INTEGER, INTENT(in)  :: knum    ! unit of the restart file
+      !! AXY (07/07/14): temporary variables
+      REAL(wp) ::    fq0,fq1,fq2
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_rst_wri_medusa : Write specific variables from medusa model '
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+
+      !! AXY (07/07/14): remove LOBSTER calls
+      !! CALL iom_rstput( kt, kitrst, knum, 'SEDB'//ctrcnm(jp_lob_det), sedpocb(:,:) )
+      !! CALL iom_rstput( kt, kitrst, knum, 'SEDN'//ctrcnm(jp_lob_det), sedpocn(:,:) )
+
+      !! AXY (07/07/14): as well as passive tracers, the restart files
+      !!                 contain 2D fields of sediments; these need to
+      !!                 be written out specially; hence this routine
+      !!
+      !! AXY (13/01/12): write out "before" and "now" state of seafloor
+      !!                 sediment pools into restart; this happens
+      !!                 whether or not the pools are to be used by
+      !!                 MEDUSA (which is controlled by a switch in the
+      !!                 namelist_top file)
+      !!
+      IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields - writing out ...'
+      CALL iom_rstput( kt, kitrst, knum, 'B_SED_N',  zb_sed_n(:,:)  )
+      CALL iom_rstput( kt, kitrst, knum, 'N_SED_N',  zn_sed_n(:,:)  )
+      CALL iom_rstput( kt, kitrst, knum, 'B_SED_FE', zb_sed_fe(:,:) )
+      CALL iom_rstput( kt, kitrst, knum, 'N_SED_FE', zn_sed_fe(:,:) )
+      CALL iom_rstput( kt, kitrst, knum, 'B_SED_SI', zb_sed_si(:,:) )
+      CALL iom_rstput( kt, kitrst, knum, 'N_SED_SI', zn_sed_si(:,:) )
+      CALL iom_rstput( kt, kitrst, knum, 'B_SED_C',  zb_sed_c(:,:)  )
+      CALL iom_rstput( kt, kitrst, knum, 'N_SED_C',  zn_sed_c(:,:)  )
+      CALL iom_rstput( kt, kitrst, knum, 'B_SED_CA', zb_sed_ca(:,:) )
+      CALL iom_rstput( kt, kitrst, knum, 'N_SED_CA', zn_sed_ca(:,:) )
+      !!
+      !! calculate stats on these fields
+      IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...'
+      fq0 = MINVAL(zn_sed_n(:,:))
+      fq1 = MAXVAL(zn_sed_n(:,:))
+      fq2 = SUM(zn_sed_n(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'Sediment  N ', &
+         &        fq0, fq1, fq2
+      fq0 = MINVAL(zn_sed_fe(:,:))
+      fq1 = MAXVAL(zn_sed_fe(:,:))
+      fq2 = SUM(zn_sed_fe(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'Sediment Fe ', &
+         &        fq0, fq1, fq2
+      fq0 = MINVAL(zn_sed_si(:,:))
+      fq1 = MAXVAL(zn_sed_si(:,:))
+      fq2 = SUM(zn_sed_si(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'Sediment Si ', &
+         &        fq0, fq1, fq2
+      fq0 = MINVAL(zn_sed_c(:,:))
+      fq1 = MAXVAL(zn_sed_c(:,:))
+      fq2 = SUM(zn_sed_c(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'Sediment  C ', &
+         &        fq0, fq1, fq2
+      fq0 = MINVAL(zn_sed_ca(:,:))
+      fq1 = MAXVAL(zn_sed_ca(:,:))
+      fq2 = SUM(zn_sed_ca(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'Sediment Ca ', &
+         &        fq0, fq1, fq2
+
+      !! AXY (07/07/15): write out temporally averaged fields for DMS
+      !!                 calculations
+      !!
+      IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS - writing out ...'
+      CALL iom_rstput( kt, kitrst, knum, 'B_DMS_CHN',  zb_dms_chn(:,:)  )
+      CALL iom_rstput( kt, kitrst, knum, 'N_DMS_CHN',  zn_dms_chn(:,:)  )
+      CALL iom_rstput( kt, kitrst, knum, 'B_DMS_CHD',  zb_dms_chd(:,:)  )
+      CALL iom_rstput( kt, kitrst, knum, 'N_DMS_CHD',  zn_dms_chd(:,:)  )
+      CALL iom_rstput( kt, kitrst, knum, 'B_DMS_MLD',  zb_dms_mld(:,:)  )
+      CALL iom_rstput( kt, kitrst, knum, 'N_DMS_MLD',  zn_dms_mld(:,:)  )
+      CALL iom_rstput( kt, kitrst, knum, 'B_DMS_QSR',  zb_dms_qsr(:,:)  )
+      CALL iom_rstput( kt, kitrst, knum, 'N_DMS_QSR',  zn_dms_qsr(:,:)  )
+      CALL iom_rstput( kt, kitrst, knum, 'B_DMS_DIN',  zb_dms_din(:,:)  )
+      CALL iom_rstput( kt, kitrst, knum, 'N_DMS_DIN',  zn_dms_din(:,:)  )
+      !!
+      !! calculate stats on these fields
+      IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS stats (min, max, sum) ...'
+      fq0 = MINVAL(zn_dms_chn(:,:))
+      fq1 = MAXVAL(zn_dms_chn(:,:))
+      fq2 = SUM(zn_dms_chn(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'DMS, CHN ', fq0, fq1, fq2
+      fq0 = MINVAL(zn_dms_chd(:,:))
+      fq1 = MAXVAL(zn_dms_chd(:,:))
+      fq2 = SUM(zn_dms_chd(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'DMS, CHD ', fq0, fq1, fq2
+      fq0 = MINVAL(zn_dms_mld(:,:))
+      fq1 = MAXVAL(zn_dms_mld(:,:))
+      fq2 = SUM(zn_dms_mld(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'DMS, MLD ', fq0, fq1, fq2
+      fq0 = MINVAL(zn_dms_qsr(:,:))
+      fq1 = MAXVAL(zn_dms_qsr(:,:))
+      fq2 = SUM(zn_dms_qsr(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'DMS, QSR ', fq0, fq1, fq2
+      fq0 = MINVAL(zn_dms_din(:,:))
+      fq1 = MAXVAL(zn_dms_din(:,:))
+      fq2 = SUM(zn_dms_din(:,:))
+      if (lwp) write (numout,'(a,3f15.5)') 'DMS, DIN ', fq0, fq1, fq2
+
+   END SUBROUTINE trc_rst_wri_medusa
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_rst_read_medusa( knum )
+     INTEGER, INTENT(in)  :: knum
+     WRITE(*,*) 'trc_rst_wri_medusa: You should not have seen this print! error?',knum
+   END SUBROUTINE trc_rst_read_medusa
+
+   SUBROUTINE trc_rst_wri_medusa( kt, kitrst, knum )
+     INTEGER, INTENT(in)  :: kt, kitrst, knum
+     WRITE(*,*) 'trc_rst_wri_medusa: You should not have seen this print! error?', kt, kitrst, knum
+   END SUBROUTINE trc_rst_wri_medusa
+#endif
+
+   !!======================================================================
+END MODULE trcrst_medusa
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcsed_medusa.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcsed_medusa.F90	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcsed_medusa.F90	(revision 8201)
@@ -0,0 +1,451 @@
+MODULE trcsed_medusa
+   !!======================================================================
+   !!                         ***  MODULE trcsed_medusa  ***
+   !! TOP :   MEDUSA Compute loss of organic matter in the sediments
+   !!======================================================================
+   !! History :    -   !  1995-06 (M. Levy)  original code
+   !!              -   !  2000-12 (E. Kestenare)  clean up
+   !!             2.0  !  2007-12  (C. Deltel, G. Madec)  F90 + simplifications
+   !!              -   !  2008-08  (K. Popova) adaptation for MEDUSA
+   !!              -   !  2008-11  (A. Yool) continuing adaptation for MEDUSA
+   !!              -   !  2010-03  (A. Yool) updated for branch inclusion
+   !!              -   !  2011-04  (A. Yool) updated for ROAM project
+   !!----------------------------------------------------------------------
+#if defined key_medusa
+   !!----------------------------------------------------------------------
+   !!   'key_medusa'                                      MEDUSA bio-model
+   !!----------------------------------------------------------------------
+   !!   trc_sed_medusa        :  Compute loss of organic matter in the sediments
+   !!----------------------------------------------------------------------
+   USE oce_trc         !
+   USE trc
+   USE sms_medusa
+   !! AXY (10/02/09)
+   USE iom
+   !! USE trc_nam_dia                   ! JPALM 13-11-2015 -- if iom_use for diag
+   !! USE trc_nam_iom_medusa            ! JPALM 13-11-2015 -- if iom_use for diag
+   USE fldread                          !  time interpolation
+   USE lbclnk
+   USE prtctl_trc                       ! Print control for debbuging
+   !! JPALM (27-06-2016): add lk_oasis for CO2 and DMS coupling with atm
+   USE sbc_oce, ONLY: lk_oasis
+   USE oce,     ONLY: Dust_in_cpl
+   !! Check Dust dep
+# if defined key_debug_medusa   
+   !! USE trcrst, ONLY: trc_rst_dia_stat   !! variable stat
+# endif
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_sed_medusa     ! called in ???
+   PUBLIC   trc_sed_medusa_sbc     
+   PUBLIC   trc_sed_medusa_dust 
+
+   !! * Module variables
+   INTEGER ::                   &
+     ryyss,                     &  !: number of seconds per year
+     rmtss                         !: number of seconds per month
+
+   !! AXY (10/02/09)
+   LOGICAL, PUBLIC  ::   bdustfer  !: boolean for dust input from the atmosphere
+   REAL(wp), PUBLIC ::                 &
+      sedfeinput = 1.e-9_wp  ,         &
+      dustsolub  = 0.014_wp
+   REAL(wp), PARAMETER :: Fe_dust_mratio = 0.035   !! Fe:dust mass ratio = 0.035
+   INTEGER , PARAMETER ::        nbtimes = 365     !: maximum number of times record in a file
+   INTEGER  :: ntimes_dust                         ! number of time steps in a file
+
+   INTEGER ::                          &
+      numdust,                         &
+      nflx1,  nflx2,                   &
+      nflx11, nflx12
+   
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_dust      ! structure of input dust
+
+   
+   !!* Substitution
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_sed_medusa( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_sed_medusa  ***
+      !!
+      !! ** Purpose :   compute the now trend due to the vertical sedimentation of
+      !!              detritus and add it to the general trend of detritus equations
+      !!
+      !! ** Method  :   this ROUTINE compute not exactly the advection but the
+      !!              transport term, i.e.  dz(wt) and dz(ws)., dz(wtr)
+      !!              using an upstream scheme
+      !!              the now vertical advection of tracers is given by:
+      !!                      dz(trn wn) = 1/bt dk+1( e1t e2t vsed (trn) )
+      !!              add this trend now to the general trend of tracer (ta,sa,tra):
+      !!                             tra = tra + dz(trn wn)
+      !!        
+      !!              IF 'key_trc_diabio' is defined, the now vertical advection
+      !!              trend of passive tracers is saved for futher diagnostics.
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index      
+      !! AXY (10/02/09)
+      INTEGER  ::   jnt
+      !!
+      INTEGER  ::   ji, jj, jk
+      REAL(wp) ::   ztra
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwork
+
+      !! AXY (10/02/09)
+      REAL(wp) ::   rfact2
+
+      CHARACTER (len=25) :: charout
+      
+      !! JPALM - 26-11-2015 -add iom_use for diagnostic
+       REAL(wp), POINTER, DIMENSION(:,:  ) :: zw2d
+      !!---------------------------------------------------------------------
+      !!
+      IF( lk_iomput) THEN  
+           IF( med_diag%DSED%dgsave ) THEN
+               CALL wrk_alloc( jpi, jpj,      zw2d )
+                zw2d(:,:)      = 0.0      !!
+           ENDIF
+      ENDIF
+      
+      !! AXY (10/02/09)
+      jnt = 1
+      rfact2 = 1.0
+
+      ! Number of seconds per year and per month
+      ryyss = nyear_len(1) * rday
+      rmtss = ryyss / raamo
+
+      !! AXY (20/11/14): alter this to report on first MEDUSA call
+      IF( kt == nittrc000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' trc_sed_medusa: MEDUSA sedimentation'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~'
+	 IF(lwp) WRITE(numout,*) ' kt =',kt
+      ENDIF
+
+      ! sedimentation of detrital nitrogen : upstream scheme
+      ! ----------------------------------------------------
+      !
+      zwork(:,:,:) = 0.e0        ! initialisation of sinking variable
+      ! for detrital nitrogen sedimentation only - jpdet
+      zwork(:,:,1  ) = 0.e0      ! surface value set to zero
+      !!    DO ji = 1, jpi
+      !!       zirondep(ji,jj,1) = (dustsolub * dust(ji,jj) / (55.85 * rmtss) + 3.e-10 / ryyss) &
+      !!       & * rfact2 / fse3t(ji,jj,1)
+      !!       zsidep  (ji,jj)   = 8.8 * 0.075 * dust(ji,jj) * rfact2 / &
+      !!       & (fse3t(ji,jj,1) * 28.1 * rmtss)
+      !!    END DO
+      !! END DO
+
+      ! sedimentation of detrital nitrogen : upstream scheme
+      ! ----------------------------------------------------
+      !
+      zwork(:,:,:) = 0.e0        ! initialisation of sinking variable
+      ! for detrital nitrogen sedimentation only - jpdet
+      zwork(:,:,1  ) = 0.e0      ! surface value set to zero
+      zwork(:,:,jpk) = 0.e0      ! bottom value  set to zero
+      !
+      ! tracer flux at w-point: we use -vsed (downward flux)  with simplification : no e1*e2
+      DO jk = 2, jpk
+         ! AXY (17/07/14): change "0.d0" to "0."
+         ! zwork(:,:,jk) = -vsed * max(trn(:,:,jk-1,jpdet),0.d0) * tmask(:,:,jk-1)
+         zwork(:,:,jk) = -vsed * max(trn(:,:,jk-1,jpdet),0.) * tmask(:,:,jk-1)
+         !
+         ! AXY (16/01/14): stop sinking in upper 10m to reduce model instability 
+         !                 in shallower grid cells
+         ! if ( jk .lt. 9 ) zwork(:,:,jk) = 0.e0
+      END DO
+      !
+      ! tracer flux divergence at t-point added to the general trend
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1,jpi
+               ztra  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / fse3t(ji,jj,jk)
+               tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + ztra
+# if defined key_trc_diabio
+               trbio(ji,jj,jk,8) = ztra
+# endif
+               IF (lk_iomput .AND. .NOT. ln_diatrc) THEN
+                     IF( med_diag%DSED%dgsave ) THEN
+                         zw2d(ji,jj) = zw2d(ji,jj) + ztra * fse3t(ji,jj,jk) * 86400.
+                      ENDIF   
+               ELSE IF( ln_diatrc )  THEN
+                    trc2d(ji,jj,8) = trc2d(ji,jj,8) + ztra * fse3t(ji,jj,jk) * 86400.
+               ENDIF    
+                
+            END DO
+         END DO
+      END DO
+      !
+# if defined key_trc_diabio
+      CALL lbc_lnk (trbio(:,:,1,8), 'T', 1. )                    ! Lateral boundary conditions on trcbio
+# endif
+      IF( ln_diatrc ) CALL lbc_lnk( trc2d(:,:,8), 'T', 1. )      ! Lateral boundary conditions on trc2d
+      !!
+      IF (lk_iomput .AND. .NOT. ln_diatrc) THEN
+           IF( med_diag%DSED%dgsave ) THEN
+                CALL iom_put( "DSED"  ,  zw2d)
+                CALL wrk_dealloc( jpi, jpj,    zw2d  )
+            ENDIF
+      ELSE IF (lk_iomput .AND. ln_diatrc)  THEN    
+          CALL iom_put( "DSED",trc2d(:,:,8) )
+      ENDIF
+      !!
+# if defined key_roam
+
+      ! sedimentation of detrital carbon : upstream scheme
+      ! --------------------------------------------------
+      !
+      zwork(:,:,:) = 0.e0        ! initialisation of sinking variable
+      ! for detrital carbon sedimentation only - jpdtc
+      zwork(:,:,1  ) = 0.e0      ! surface value set to zero
+      zwork(:,:,jpk) = 0.e0      ! bottom value  set to zero
+      !
+      ! tracer flux at w-point: we use -vsed (downward flux)  with simplification : no e1*e2
+      DO jk = 2, jpk
+         ! AXY (17/07/14): change "0.d0" to "0."
+         ! zwork(:,:,jk) = -vsed * max(trn(:,:,jk-1,jpdtc),0.d0) * tmask(:,:,jk-1)
+         zwork(:,:,jk) = -vsed * max(trn(:,:,jk-1,jpdtc),0.) * tmask(:,:,jk-1)
+         !
+         ! AXY (16/01/14): stop sinking in upper 10m to reduce model instability 
+         !                 in shallower grid cells
+         ! if ( jk .lt. 9 ) zwork(:,:,jk) = 0.e0
+      END DO
+      !
+      ! tracer flux divergence at t-point added to the general trend
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1,jpi
+               ztra  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / fse3t(ji,jj,jk)
+               tra(ji,jj,jk,jpdtc) = tra(ji,jj,jk,jpdtc) + ztra
+!! #  if defined key_trc_diabio
+!!                trbio(ji,jj,jk,8) = ztra
+!! #  endif
+!!             IF( ln_diatrc ) &
+!!                &  trc2d(ji,jj,8) = trc2d(ji,jj,8) + ztra * fse3t(ji,jj,jk) * 86400.
+            END DO
+         END DO
+      END DO
+      !
+!! #  if defined key_trc_diabio
+!!       CALL lbc_lnk (trbio(:,:,1,8), 'T', 1. )                    ! Lateral boundary conditions on trcbio
+!! #  endif
+!!       IF( ln_diatrc ) CALL lbc_lnk( trc2d(:,:,8), 'T', 1. )      ! Lateral boundary conditions on trc2d
+!! #  if defined key_iomput
+!!       CALL iom_put( "DSED",trc2d(:,:,8) )
+!! #  endif
+
+# endif
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('sed')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+      ENDIF
+
+   END SUBROUTINE trc_sed_medusa
+
+   !! ======================================================================
+   !! ======================================================================
+   !! ======================================================================
+
+   !! AXY (10/02/09)
+   !! JPALM -- 31-03-2016 -- Completely change trc_sed_medusa_sbc.
+   !!                     -- We now need to read dust file through a namelist.
+   !!                     To be able to use time varying dust depositions from
+   !!                     -- copy and adapt the PISCES p4z_sbc_ini subroutine
+   !!                     -- Only use the dust related part.      
+   SUBROUTINE trc_sed_medusa_sbc(kt)
+
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_sed_medusa_sbc  ***
+      !!
+      !! ** Purpose :   Read and dust namelist and files.
+      !!                The interpolation is done in trc_sed through 
+      !!                "CALL fld_read( kt, 1, sf_dust )"
+      !!
+      !! ** Method  :   Read the sbc namelist, and the adapted dust file, if required
+      !!                called at the first timestep (nittrc000)
+      !!
+      !! ** input   :   -- namelist sbc ref and cfg
+      !!                -- external netcdf files
+      !!
+      !!----------------------------------------------------------------------
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+      INTEGER  :: ji, jj, jk, jm, ifpr
+      INTEGER  :: ii0, ii1, ij0, ij1
+      INTEGER  :: numdust
+      INTEGER  :: ierr 
+      INTEGER  :: jfld                ! dummy loop arguments
+      INTEGER  :: ios                 ! Local integer output status for namelist read
+      INTEGER  :: isrow               ! index for ORCA1 starting row
+      REAL(wp) :: ztimes_dust
+      REAL(wp), DIMENSION(nbtimes) :: zsteps                 ! times records
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zdust
+      !
+      CHARACTER(len=100)         ::  cn_dir       ! Root directory for location of ssr files
+      TYPE(FLD_N), DIMENSION(1)  ::   slf_d       ! array of namelist informations on the fields to read
+      TYPE(FLD_N)                ::   sn_dust     ! informations about the fields to be read
+      !
+      NAMELIST/nammedsbc/cn_dir, sn_dust, bdustfer 
+
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_sed_medusa_sbc')
+      !
+      !                            !* set file information
+      REWIND( numnatp_ref )        ! Namelist nammedsbc in reference namelist : MEDUSA external sources of Dust
+      READ  ( numnatp_ref, nammedsbc, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammedsbc in reference namelist', lwp )
+
+      REWIND( numnatp_cfg )        ! Namelist nammedsbc in configuration namelist : MEDUSA external sources of Dust
+      READ  ( numnatp_cfg, nammedsbc, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammedsbc in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, nammedsbc )
+
+      IF(lwp) THEN
+          WRITE(numout,*) ' '
+          WRITE(numout,*) ' namelist : nammedsbc '
+          WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~ '
+          WRITE(numout,*) '    dust input from the atmosphere bdustfer     = ', bdustfer
+      END IF
+
+      ! dust input from the atmosphere
+      ! ------------------------------
+      IF( bdustfer ) THEN
+         !
+         IF(lwp) WRITE(numout,*) '    initialize dust input from atmosphere '
+         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
+         !
+         !! already allocated in sms_medusa
+         !!ALLOCATE( dust(jpi,jpj) )    ! allocation
+         !
+         slf_d(1) = sn_dust                          ! store namelist information in an array
+         !
+         ALLOCATE( sf_dust(1), STAT=ierr )           !* allocate and fill sf_sst (forcing structure) with sn_sst
+         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'trc_sed_medusa_sbc: unable to allocate sf_dust structure' )
+         ALLOCATE( sf_dust(1)%fnow(jpi,jpj,1))
+         IF( slf_d(1)%ln_tint )     ALLOCATE( sf_dust(1)%fdta(jpi,jpj,1,2) )
+         !
+         CALL fld_fill( sf_dust, slf_d, cn_dir, 'trc_sed_medusa_sbc', 'Atmospheric dust deposition', 'nammedsed' )
+         !
+         CALL fld_read( kt, 1, sf_dust )
+         dust(:,:) = sf_dust(1)%fnow(:,:,1)
+         !
+      ELSEIF (lk_oasis) THEN
+         dust = Dust_in_cpl
+      ELSE
+         dust(:,:) = 0.0
+      END IF
+      !
+      zirondep(:,:) = 0.e0     !! Initialisation of deposition variables
+      zirondep(:,:) = dust(:,:) * Fe_dust_mratio / xfe_mass * 1.e6 * 86400.      !! mmol-Fe/m2/d
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_sed_medusa_sbc')
+      !
+   END SUBROUTINE trc_sed_medusa_sbc
+
+   !! ======================================================================
+   !! ======================================================================
+   !! ======================================================================
+
+   !! AXY & JPALM (28/02/17)
+
+   SUBROUTINE trc_sed_medusa_dust( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_sed_medusa_dust  ***
+      !!
+      !! ** Purpose : compute current dust *before* trc_bio_medusa call
+      !!
+      !! ** Method  : does what it says on the tin
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index      
+
+      !! AXY (20/11/14): alter this to report on first MEDUSA call
+      IF( kt == nittrc000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' trc_sed_medusa_dust: MEDUSA dust timestep'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~'
+	 IF(lwp) WRITE(numout,*) ' kt =',kt
+      ENDIF
+
+      !! AXY (04/11/13): replace this with a call in trc_ini_medusa
+      !! AXY (25/02/10)
+      !! call routine for populating CCD array if this is the first time-step
+      !! IF( kt == nittrc000 ) CALL medusa_ccd( kt )
+
+      !! AXY (04/11/13): replace this with a call in trc_ini_medusa
+      !! AXY (26/01/12)
+      !! call routine for populating river arrays if this is the first time-step
+      !! IF( kt == nittrc000 ) CALL medusa_river( kt )
+
+      !! AXY (10/02/09)
+      !! IF( (jnt == 1) .and. (bdustfer) )  CALL trc_sed_medusa_sbc( kt )
+
+      !! JPALM -- 31-03-2016 -- rewrite trc_sed_medusa_sbc.
+      !! IF (kt == nittrc000 ) CALL trc_sed_medusa_sbc 
+
+      !! JPALM -- 20-07-2016 -- adapt dust forcing fields reading and conversion
+      !!                     To read dust dep in kg-dust/m2/s instead of g-Fe/m2/month 
+      !!                     So all forcings and coupling dust dep are in the same SI units
+      !!                     and then convert in mmol-Fe/m2/day
+
+      IF( bdustfer ) THEN
+            CALL fld_read( kt, 1, sf_dust )
+            dust(:,:) = sf_dust(1)%fnow(:,:,1)
+      ELSEIF (lk_oasis) THEN
+         dust = Dust_in_cpl
+      ELSE
+         dust(:,:) = 0.0
+      ENDIF
+      !!
+      zirondep(:,:) = 0.e0     !! Initialisation of deposition variables
+      zirondep(:,:) = dust(:,:) * Fe_dust_mratio / xfe_mass * 1.e6 * 86400.  !! mmol-Fe/m2/d
+      
+      !! JPALM -- 20-07-2016 -- Zirondep and zsidep are not used.
+      !!                     So comment out the following lines. but keep them
+      !!                     as we may want to used them later on
+      !!================================================     
+      !!
+      !! zirondep(:,:,:) = 0.e0     !! Initialisation of deposition variables
+      !! zsidep  (:,:)   = 0.e0
+      !!
+      !! Iron and Si deposition at the surface
+      !! -------------------------------------
+      !!
+      !! DO jj = 1, jpj
+      !!    DO ji = 1, jpi
+      !!       zirondep(ji,jj,1) = (dustsolub * dust(ji,jj) / (55.85 * rmtss) + 3.e-10 / ryyss) &
+      !!       & * rfact2 / fse3t(ji,jj,1)
+      !!       zsidep  (ji,jj)   = 8.8 * 0.075 * dust(ji,jj) * rfact2 / &
+      !!       & (fse3t(ji,jj,1) * 28.1 * rmtss)
+      !!    END DO
+      !! END DO
+
+   END SUBROUTINE trc_sed_medusa_dust
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No MEDUSA bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE trc_sed_medusa( kt )                   ! Empty routine
+      INTEGER, INTENT( in ) ::   kt
+      WRITE(*,*) 'trc_sed_medusa: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_sed_medusa
+#endif 
+
+   !!======================================================================
+END MODULE  trcsed_medusa
+
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcsms_medusa.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcsms_medusa.F90	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcsms_medusa.F90	(revision 8201)
@@ -0,0 +1,112 @@
+MODULE trcsms_medusa
+   !!======================================================================
+   !!                         ***  MODULE trcsms_medusa  ***
+   !! TOP :   Main module of the MEDUSA tracers
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code
+   !!              -   !  2008-08  (K. Popova) adaptation for MEDUSA
+   !!              -   !  2008-11  (A. Yool) continuing adaptation for MEDUSA
+   !!              -   !  2010-03  (A. Yool) updated for branch inclusion
+   !!----------------------------------------------------------------------
+#if defined key_medusa
+   !!----------------------------------------------------------------------
+   !!   'key_medusa'                                       bio tracers
+   !!----------------------------------------------------------------------
+   !! trc_sms_medusa   : MEDUSA_TRC model main routine 
+   !!----------------------------------------------------------------------
+   USE par_trc         ! TOP parameters
+   USE oce_trc
+   USE trc
+   USE trcbio_medusa
+   USE trcopt_medusa
+   USE trcsed_medusa
+   USE trcavg_medusa
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_sms_medusa   ! called by trcsms.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_sms_medusa( kt )
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_sms_medusa  ***  
+      !!
+      !! ** Purpose :   main routine of MEDUSA_TRC model
+      !!
+      !! ** Method  : - 
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: kt   ! ocean time-step index
+
+# if defined key_debug_medusa
+         IF(lwp) WRITE(numout,*) ' MEDUSA inside trc_sms_medusa'
+         CALL flush(numout)
+# endif
+
+      IF( kt == nittrc000 ) THEN
+       IF(lwp) WRITE(numout,*)
+       IF(lwp) WRITE(numout,*) ' trc_sms_medusa:  MEDUSA model'
+       IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+      ENDIF
+
+      CALL trc_avg_medusa( kt ) ! rolling average module
+# if defined key_debug_medusa
+      IF(lwp) WRITE(numout,*) ' MEDUSA done trc_avg_medusa'
+      CALL flush(numout)
+# endif
+      
+      CALL trc_opt_medusa( kt ) ! optical model
+# if defined key_debug_medusa
+      IF(lwp) WRITE(numout,*) ' MEDUSA done trc_opt_medusa'
+      CALL flush(numout)
+# endif
+
+      !! AXY & JPALM (28/02/17): call dust before trc_bio_medusa (because of coupling)
+      CALL trc_sed_medusa_dust( kt ) ! dust submodel
+# if defined key_debug_medusa
+      IF(lwp) WRITE(numout,*) ' MEDUSA done trc_sed_medusa_dust'
+      CALL flush(numout)
+# endif
+
+# if defined key_kill_medusa
+      !! MEDUSA skipped
+      IF(lwp) WRITE(numout,*) ' MEDUSA killed at kt =', kt
+      CALL flush(numout)
+# else
+      CALL trc_bio_medusa( kt ) ! biological model
+#  if defined key_debug_medusa
+      IF(lwp) WRITE(numout,*) ' MEDUSA done trc_bio_medusa'
+      CALL flush(numout)
+#  endif
+      
+      CALL trc_sed_medusa( kt ) ! sedimentation model
+#  if defined key_debug_medusa
+      IF(lwp) WRITE(numout,*) ' MEDUSA done trc_sed_medusa'
+      CALL flush(numout)
+#  endif
+# endif
+
+   END SUBROUTINE trc_sms_medusa
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                                        No MEDUSA model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_sms_medusa( kt )             ! Empty routine
+      INTEGER, INTENT( in ) ::   kt
+      WRITE(*,*) 'trc_sms_medusa: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_sms_medusa
+#endif
+
+   !!======================================================================
+END MODULE trcsms_medusa
+
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcwri_medusa.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcwri_medusa.F90	(revision 8201)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcwri_medusa.F90	(revision 8201)
@@ -0,0 +1,60 @@
+MODULE trcwri_medusa
+   !!======================================================================
+   !!                       *** MODULE trcwri ***
+   !!    MEDUSA :   Output of MEDUSA tracers
+   !!======================================================================
+   !! History :   1.0  !  2009-05 (C. Ethe)  Original code
+   !!             1.1  !  2013-05 (A. Yool)  converted for MEDUSA
+   !!----------------------------------------------------------------------
+#if defined key_top && defined key_iomput && defined key_medusa
+   !!----------------------------------------------------------------------
+   !!   'key_medusa'                                           MEDUSA model
+   !!----------------------------------------------------------------------
+   !! trc_wri_medusa   :  outputs of concentration fields
+   !!----------------------------------------------------------------------
+   USE trc         ! passive tracers common variables 
+   USE sms_medusa  ! MEDUSA variables
+   USE iom         ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC trc_wri_medusa 
+
+CONTAINS
+
+   SUBROUTINE trc_wri_medusa
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_wri_trc  ***
+      !!
+      !! ** Purpose :   output passive tracers fields 
+      !!---------------------------------------------------------------------
+      CHARACTER (len=20)   :: cltra
+      INTEGER              :: jn
+      !!---------------------------------------------------------------------
+ 
+      ! write the tracer concentrations in the file
+      ! ---------------------------------------
+      DO jn = jp_msa0, jp_msa1
+         cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer
+         CALL iom_put( cltra, trn(:,:,:,jn) )
+      END DO
+      !
+   END SUBROUTINE trc_wri_medusa
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+   PUBLIC trc_wri_medusa
+CONTAINS
+   SUBROUTINE trc_wri_medusa                     ! Empty routine  
+   END SUBROUTINE trc_wri_medusa
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE trcwri_medusa
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90	(revision 8200)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90	(revision 8201)
@@ -29,4 +29,5 @@
    USE trdtra
    USE prtctl_trc      ! Print control
+   !! USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
 
    IMPLICIT NONE
@@ -73,5 +74,5 @@
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
       !
-      INTEGER ::   jk 
+      INTEGER ::   jk, jn 
       CHARACTER (len=22) ::   charout
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn  ! effective velocity
@@ -108,4 +109,11 @@
       zvn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom
       zwn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom
+      ! 
+      !! Jpalm -- 14-01-2016 -- restart and proc pb - try this... 
+      !! DO jn = 1, jptra
+      !!   CALL lbc_lnk( trn(:,:,:,jn), 'T', 1. )
+      !!   CALL lbc_lnk( trb(:,:,:,jn), 'T', 1. )
+      !! END DO
+      !
 
       IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif )   &  ! add the eiv transport (if necessary)
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90	(revision 8200)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90	(revision 8201)
@@ -102,15 +102,18 @@
          IF(lwp) WRITE(numout,*) '~~~~~~~ '
 
-         IF( ln_rsttr .AND.    &                     ! Restart: read in restart  file
-            iom_varid( numrtr, 'sbc_'//TRIM(ctrcnm(1))//'_b', ldstop = .FALSE. ) > 0 ) THEN
-            IF(lwp) WRITE(numout,*) '          nittrc000-nn_dttrc surface tracer content forcing fields red in the restart file'
-            zfact = 0.5_wp
-            DO jn = 1, jptra
-               CALL iom_get( numrtr, jpdom_autoglo, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc_b(:,:,jn) )   ! before tracer content sbc
-            END DO
-         ELSE                                         ! No restart or restart not found: Euler forward time stepping
+         !! JPALM -- 12-01-2016 -- problem after restart, maybe because of this...
+         !!                     -- set sbc_trc_b to 0 after restart, first, to check.
+         !!------------------------------------------------------------------------------
+        ! IF( ln_rsttr .AND.    &                     ! Restart: read in restart  file
+        !    iom_varid( numrtr, 'sbc_'//TRIM(ctrcnm(1))//'_b', ldstop = .FALSE. ) > 0 ) THEN
+        !    IF(lwp) WRITE(numout,*) '          nittrc000-nn_dttrc surface tracer content forcing fields red in the restart file'
+        !    zfact = 0.5_wp
+        !    DO jn = 1, jptra
+        !       CALL iom_get( numrtr, jpdom_autoglo, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc_b(:,:,jn) )   ! before tracer content sbc
+        !    END DO
+        ! ELSE                                         ! No restart or restart not found: Euler forward time stepping
            zfact = 1._wp
            sbc_trc_b(:,:,:) = 0._wp
-         ENDIF
+        ! ENDIF
       ELSE                                         ! Swap of forcing fields
          IF( ln_top_euler ) THEN
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90	(revision 8200)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90	(revision 8201)
@@ -27,4 +27,8 @@
    USE trcsbc          ! surface boundary condition          (trc_sbc routine)
    USE zpshde          ! partial step: hor. derivative       (zps_hde routine)
+# if defined key_debug_medusa
+   USE trcrst
+# endif
+
 
 #if defined key_agrif
@@ -65,7 +69,17 @@
          !
                                 CALL trc_sbc( kstp )            ! surface boundary condition
+# if defined key_debug_medusa
+         IF(lwp) WRITE(numout,*) ' MEDUSA trc_trp after trc_sbc at kt =', kstp
+         CALL trc_rst_tra_stat
+         CALL flush(numout)
+# endif
          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
                                 CALL trc_adv( kstp )            ! horizontal & vertical advection 
+# if defined key_debug_medusa
+         IF(lwp) WRITE(numout,*) ' MEDUSA trc_trp after trc_adv at kt =', kstp
+         CALL trc_rst_tra_stat
+         CALL flush(numout)
+# endif
                                 CALL trc_ldf( kstp )            ! lateral mixing
          IF( .NOT. lk_offline .AND. lk_zdfkpp )    &
@@ -75,5 +89,15 @@
 #endif
                                 CALL trc_zdf( kstp )            ! vertical mixing and after tracer fields
+# if defined key_debug_medusa
+         IF(lwp) WRITE(numout,*) ' MEDUSA trc_trp after trc_zdf at kt =', kstp
+         CALL trc_rst_tra_stat
+         CALL flush(numout)
+# endif
                                 CALL trc_nxt( kstp )            ! tracer fields at next time step     
+# if defined key_debug_medusa
+         IF(lwp) WRITE(numout,*) ' MEDUSA trc_trp after trc_nxt at kt =', kstp
+         CALL trc_rst_tra_stat
+         CALL flush(numout)
+# endif
          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
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/par_trc.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/par_trc.F90	(revision 8200)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/par_trc.F90	(revision 8201)
@@ -8,4 +8,5 @@
    !!             1.0  !  2004-03  (C. Ethe) Free form and module
    !!             2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture
+   !!              -   !  2014-06  (A. Yool, J. Palmieri) adding MEDUSA-2
    !!----------------------------------------------------------------------
    USE par_kind          ! kind parameters
@@ -15,4 +16,7 @@
    USE par_cfc       ! CFC 11 and 12 tracers
    USE par_my_trc    ! user defined passive tracers
+   USE par_medusa    ! MEDUSA model
+   USE par_idtra     ! Idealize tracer
+   USE par_age       ! AGE  tracer
 
    IMPLICIT NONE
@@ -24,9 +28,9 @@
    ! Passive tracers : Total size
    ! ---------------               ! total number of passive tracers, of 2d and 3d output and trend arrays
-   INTEGER, PUBLIC,  PARAMETER ::   jptra    =  jp_pisces     + jp_cfc     + jp_c14b    + jp_my_trc
-   INTEGER, PUBLIC,  PARAMETER ::   jpdia2d  =  jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d + jp_my_trc_2d
-   INTEGER, PUBLIC,  PARAMETER ::   jpdia3d  =  jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d + jp_my_trc_3d
+   INTEGER, PUBLIC,  PARAMETER ::   jptra    =  jp_pisces     + jp_cfc     + jp_c14b    + jp_my_trc    + jp_medusa    + jp_idtra     + jp_age
+   INTEGER, PUBLIC,  PARAMETER ::   jpdia2d  =  jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d + jp_my_trc_2d + jp_medusa_2d + jp_idtra_2d  + jp_age_2d
+   INTEGER, PUBLIC,  PARAMETER ::   jpdia3d  =  jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d + jp_my_trc_3d + jp_medusa_3d + jp_idtra_3d  + jp_age_3d
    !                     ! total number of sms diagnostic arrays
-   INTEGER, PUBLIC,  PARAMETER ::   jpdiabio =  jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd
+   INTEGER, PUBLIC,  PARAMETER ::   jpdiabio =  jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd + jp_medusa_trd + jp_idtra_trd + jp_age_trd
    
    !  1D configuration ("key_c1d")
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/trc.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/trc.F90	(revision 8200)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/trc.F90	(revision 8201)
@@ -7,4 +7,5 @@
    !!              -   !  2000-04  (O. Aumont, M.A. Foujols)  HAMOCC3 and P3ZD
    !!   NEMO      1.0  !  2004-03  (C. Ethe)  Free form and module
+   !!             3.6  !  2016-11  (A. Yool)  Updated diags for CMIP6
    !!----------------------------------------------------------------------
 #if defined key_top
@@ -25,5 +26,5 @@
    INTEGER, PUBLIC                                                 ::   numnat_cfg = -1   !: logical unit for the reference passive tracer namelist_top_cfg
    INTEGER, PUBLIC                                                 ::   numont     = -1   !: logical unit for the reference passive tracer namelist output output.namelist.top
-   INTEGER, PUBLIC                                                 ::   numstr        !: logical unit for tracer statistics
+   INTEGER, PUBLIC                                                 ::   numstr     = -1   !: logical unit for tracer statistics
    INTEGER, PUBLIC                                                 ::   numrtr        !: logical unit for trc restart (read )
    INTEGER, PUBLIC                                                 ::   numrtw        !: logical unit for trc restart ( write )
@@ -104,4 +105,54 @@
    END TYPE DIAG
 
+#if defined key_medusa && defined key_iomput
+   TYPE, PUBLIC :: BDIAG
+      LOGICAL              :: dgsave
+   END TYPE BDIAG
+   
+   TYPE, PUBLIC :: DIAG_IOM
+      TYPE(BDIAG) INVTN, INVTSI, INVTFE, PRN, MPN, PRD, MPD, DSED, OPAL, OPALDISS, GMIPn,            &
+                  GMID, MZMI, GMEPN, GMEPD, GMEZMI, GMED, MZME, DEXP, DETN, MDET, AEOLIAN, BENTHIC,  &
+                  SCAVENGE, PN_JLIM, PN_NLIM, PN_FELIM, PD_JLIM, PD_NLIM, PD_FELIM, PD_SILIM,        &
+                  PDSILIM2, SDT__100, SDT__200, SDT__500, SDT_1000, TOTREG_N, TOTRG_SI, REG__100,    &
+                  REG__200, REG__500, REG_1000, FASTN, FASTSI, FASTFE, FASTC, FASTCA, FDT__100,      &
+                  FDT__200, FDT__500, FDT_1000, RG__100F, RG__200F, RG__500F, RG_1000F, FDS__100,    &
+                  FDS__200, FDS__500, FDS_1000, RGS_100F, RGS_200F, RGS_500F, RGS1000F, REMINN,      &
+                  REMINSI, REMINFE, REMINC, REMINCA, SEAFLRN, SEAFLRSI, SEAFLRFE, SEAFLRC, SEAFLRCA, &
+                  MED_QSR, MED_XPAR, INTFLX_N, INTFLX_SI, INTFLX_FE, INT_PN, INT_PD, ML_PRN, ML_PRD, &
+                  OCAL_CCD, OCAL_LVL, FE_0000, FE_0100, FE_0200, FE_0500, FE_1000, MED_XZE, WIND,    &
+                  ATM_PCO2, OCN_PH, OCN_PCO2, OCNH2CO3, OCN_HCO3, OCN_CO3, CO2FLUX, OM_CAL, OM_ARG,  &
+                  TCO2, TALK, KW660, ATM_PP0, O2FLUX, O2SAT, CAL_CCD, ARG_CCD, SFR_OCAL, SFR_OARG,   &
+                  N_PROD, N_CONS, C_PROD, C_CONS, O2_PROD, O2_CONS, O2_ANOX, RR_0100, RR_0500,       &
+                  RR_1000, IBEN_N, IBEN_FE, IBEN_C, IBEN_SI, IBEN_CA, OBEN_N, OBEN_FE, OBEN_C,       &
+                  OBEN_SI, OBEN_CA, BEN_N, BEN_FE, BEN_C, BEN_SI, BEN_CA, RUNOFF, RIV_N, RIV_SI,     &
+                  RIV_C, RIV_ALK, DETC, SDC__100, SDC__200, SDC__500, SDC_1000, INVTC, INVTALK,      &
+                  INVTO2, LYSO_CA, COM_RESP, PN_LLOSS, PD_LLOSS, ZI_LLOSS, ZE_LLOSS, ZI_MES_N,       &
+                  ZI_MES_D, ZI_MES_C, ZI_MESDC, ZI_EXCR, ZI_RESP, ZI_GROW, ZE_MES_N, ZE_MES_D,       &
+                  ZE_MES_C, ZE_MESDC, ZE_EXCR, ZE_RESP, ZE_GROW, MDETC, GMIDC, GMEDC,                &
+                  INT_ZMI, INT_ZME, INT_DET, INT_DTC, DMS_SURF, DMS_ANDR, DMS_SIMO, DMS_ARAN,        &
+                  DMS_HALL, DMS_ANDM, ATM_XCO2, OCN_FCO2, ATM_FCO2, OCN_RHOSW, OCN_SCHCO2,           &
+                  OCN_KWCO2, OCN_K0, CO2STARAIR, OCN_DPCO2,                                          & ! end of regular 2D
+                  TPP3, DETFLUX3, REMIN3N, PH3, OM_CAL3,                                             & ! end of regular 3D
+! AXY (11/11/16): additional CMIP6 2D diagnostics
+                  epC100, epCALC100, epN100, epSI100,                                                &
+                  FGCO2, INTDISSIC, INTDISSIN, INTDISSISI, INTTALK, O2min, ZO2min,                   &
+                  FBDDTALK, FBDDTDIC, FBDDTDIFE, FBDDTDIN, FBDDTDISI,                                & 
+! AXY (11/11/16): additional CMIP6 3D diagnostics
+                  TPPD3,                                                                             &
+                  BDDTALK3, BDDTDIC3, BDDTDIFE3, BDDTDIN3, BDDTDISI3,                                & 
+                  FD_NIT3, FD_SIL3, FD_CAR3, FD_CAL3,                                                & 
+                  CO33, CO3SATARAG3, CO3SATCALC3, DCALC3,                                            &
+                  EXPC3, EXPN3, EXPCALC3, EXPSI3,                                                    &
+                  FEDISS3, FESCAV3,                                                                  &
+                  MIGRAZP3, MIGRAZD3, MEGRAZP3, MEGRAZD3, MEGRAZZ3,                                  &
+                  O2SAT3, PBSI3, PCAL3, REMOC3,                                                      &
+                  PNLIMJ3, PNLIMN3, PNLIMFE3, PDLIMJ3, PDLIMN3, PDLIMFE3, PDLIMSI3       
+                  !!
+                  !! list of all MEDUSA diagnostics that could be called by iom_use
+   END TYPE DIAG_IOM  
+   !!
+   TYPE(DIAG_IOM), PUBLIC :: med_diag  ! define which diagnostics are asked in outputs
+# endif                   
+
    !! information for inputs
    !! --------------------------------------------------
@@ -216,4 +267,8 @@
 
       IF( trc_alloc /= 0 )   CALL ctl_warn('trc_alloc: failed to allocate arrays')
+
+      ! It is known that not intialising SBC_TRC can introduce NaNs
+      sbc_trc(:,:,:) = 0.0
+
       !
    END FUNCTION trc_alloc
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/trcini.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/trcini.F90	(revision 8200)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/trcini.F90	(revision 8201)
@@ -8,4 +8,5 @@
    !!            2.0  ! 2005-10 (C. Ethe, G. Madec) revised architecture
    !!            4.0  ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation
+   !!             -   ! 2014-06 (A. Yool, J. Palmieri) adding MEDUSA-2
    !!----------------------------------------------------------------------
 #if defined key_top
@@ -24,4 +25,7 @@
    USE trcini_c14b     ! C14 bomb initialisation
    USE trcini_my_trc   ! MY_TRC   initialisation
+   USE trcini_medusa   ! MEDUSA   initialisation
+   USE trcini_idtra    ! idealize tracer initialisation
+   USE trcini_age      ! AGE      initialisation
    USE trcdta          ! initialisation from files
    USE daymod          ! calendar manager
@@ -76,5 +80,7 @@
          &   CALL ctl_warn(' Coupling with passive tracers and used of diurnal cycle. &
          & Computation of a daily mean shortwave for some biogeochemical models) ')
-
+          !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+          !!!!! CHECK For MEDUSA
+          !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       IF( nn_cla == 1 )   &
          &  CALL ctl_stop( ' Cross Land Advection not yet implemented with passive tracer ; nn_cla must be 0' )
@@ -97,24 +103,70 @@
 
       IF( lk_pisces  )       CALL trc_ini_pisces       ! PISCES  bio-model
+      IF( lk_medusa  )       CALL trc_ini_medusa       ! MEDUSA  tracers
+      IF( lk_idtra   )       CALL trc_ini_idtra        ! Idealize tracers
       IF( lk_cfc     )       CALL trc_ini_cfc          ! CFC     tracers
       IF( lk_c14b    )       CALL trc_ini_c14b         ! C14 bomb  tracer
+      IF( lk_age     )       CALL trc_ini_age          ! AGE       tracer
       IF( lk_my_trc  )       CALL trc_ini_my_trc       ! MY_TRC  tracers
 
       CALL trc_ice_ini                                 ! Tracers in sea ice
 
-      IF( lwp ) THEN
+# if defined key_debug_medusa
+         IF (lwp) write (numout,*) '------------------------------'
+         IF (lwp) write (numout,*) 'Jpalm - debug'
+         IF (lwp) write (numout,*) ' in trc_init'
+         IF (lwp) write (numout,*) ' sms init OK'
+         IF (lwp) write (numout,*) ' next: open tracer.stat'
+         IF (lwp) write (numout,*) ' '
+         CALL flush(numout)
+# endif
+
+      IF( ln_ctl ) THEN
          !
-         CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp , narea )
+         IF (narea == 1) THEN  
+            ! The tracer.stat file only contains global tracer sum values, if 
+            ! it contains anything at all. Hence it only needs to be opened 
+            ! and written to on the master PE, not on all PEs.  
+            CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE','FORMATTED',  & 
+                          'SEQUENTIAL', -1, numout, lwp , narea ) 
+         ENDIF  
          !
       ENDIF
 
-      IF( ln_trcdta )      CALL trc_dta_init(jptra)
-
+# if defined key_debug_medusa
+         IF (lwp) write (numout,*) '------------------------------'
+         IF (lwp) write (numout,*) 'Jpalm - debug'
+         IF (lwp) write (numout,*) ' in trc_init'
+         IF (lwp) write (numout,*) 'open tracer.stat -- OK'
+         IF (lwp) write (numout,*) ' '
+         CALL flush(numout)
+# endif
+
+
+      IF( ln_trcdta ) THEN
+#if defined key_medusa
+         IF(lwp) WRITE(numout,*) 'AXY: calling trc_dta_init'
+         IF(lwp) CALL flush(numout)
+#endif
+         CALL trc_dta_init(jptra)
+      ENDIF
 
       IF( ln_rsttr ) THEN
         !
+#if defined key_medusa
+        IF(lwp) WRITE(numout,*) 'AXY: calling trc_rst_read'
+        IF(lwp) CALL flush(numout)
+#endif
         CALL trc_rst_read              ! restart from a file
         !
       ELSE
+        !
+# if defined key_debug_medusa
+         IF (lwp) write (numout,*) '------------------------------'
+         IF (lwp) write (numout,*) 'Jpalm - debug'
+         IF (lwp) write (numout,*) ' Init from file -- will call trc_dta'
+         IF (lwp) write (numout,*) ' '
+         CALL flush(numout)
+# endif
         !
         IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN  ! Initialisation of tracer from a file that may also be used for damping
@@ -137,5 +189,23 @@
         ENDIF
         !
+# if defined key_debug_medusa
+         IF (lwp) write (numout,*) '------------------------------'
+         IF (lwp) write (numout,*) 'Jpalm - debug'
+         IF (lwp) write (numout,*) ' in trc_init'
+         IF (lwp) write (numout,*) ' before trb = trn'
+         IF (lwp) write (numout,*) ' '
+         CALL flush(numout)
+# endif
+        !
         trb(:,:,:,:) = trn(:,:,:,:)
+        ! 
+# if defined key_debug_medusa
+         IF (lwp) write (numout,*) '------------------------------'
+         IF (lwp) write (numout,*) 'Jpalm - debug'
+         IF (lwp) write (numout,*) ' in trc_init'
+         IF (lwp) write (numout,*) ' trb = trn -- OK'
+         IF (lwp) write (numout,*) ' '
+         CALL flush(numout)
+# endif
         ! 
       ENDIF
@@ -146,10 +216,25 @@
       IF( ln_zps .AND. .NOT. lk_c1d .AND.       ln_isfcav )   &
         &    CALL zps_hde_isf( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi )       ! tracers at the bottom ocean level
-
-
+      !
+# if defined key_debug_medusa
+         IF (lwp) write (numout,*) '------------------------------'
+         IF (lwp) write (numout,*) 'Jpalm - debug'
+         IF (lwp) write (numout,*) ' in trc_init'
+         IF (lwp) write (numout,*) ' partial step -- OK'
+         IF (lwp) write (numout,*) ' '
+         CALL flush(numout)
+# endif
       !
       IF( nn_dttrc /= 1 )        CALL trc_sub_ini      ! Initialize variables for substepping passive tracers
       !
-
+# if defined key_debug_medusa
+         IF (lwp) write (numout,*) '------------------------------'
+         IF (lwp) write (numout,*) 'Jpalm - debug'
+         IF (lwp) write (numout,*) ' in trc_init'
+         IF (lwp) write (numout,*) ' before initiate tracer contents'
+         IF (lwp) write (numout,*) ' '
+         CALL flush(numout)
+# endif
+      !
       trai(:) = 0._wp                                                   ! initial content of all tracers
       DO jn = 1, jptra
@@ -164,4 +249,12 @@
          WRITE(numout,*) '          *** Total inital content of all tracers '
          WRITE(numout,*)
+# if defined key_debug_medusa
+         CALL flush(numout)
+# endif
+         !
+# if defined key_debug_medusa
+         WRITE(numout,*) ' litle check :  ', ctrcnm(1)
+         CALL flush(numout)
+# endif
          DO jn = 1, jptra
             WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn)
@@ -176,4 +269,14 @@
          CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm )
       ENDIF
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'trc_init : passive tracer set up completed'
+      IF(lwp) WRITE(numout,*) '~~~~~~~'
+      IF(lwp) CALL flush(numout)
+# if defined key_debug_medusa
+         CALL trc_rst_stat
+         CALL flush(numout)
+# endif
+
 9000  FORMAT(' tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10)
       !
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/trcnam.F90	(revision 8200)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/trcnam.F90	(revision 8201)
@@ -11,4 +11,5 @@
    !!              -   !  2001-01 (E Kestenare) suppress ndttrc=1 for CEN2 and TVD schemes
    !!             1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90
+   !!              -   !  2014-06  (A. Yool, J. Palmieri) adding MEDUSA-2
    !!----------------------------------------------------------------------
 #if defined key_top
@@ -25,4 +26,7 @@
    USE trcnam_c14b       ! C14 SMS namelist
    USE trcnam_my_trc     ! MY_TRC SMS namelist
+   USE trcnam_medusa     ! MEDUSA namelist
+   USE trcnam_idtra      ! Idealise tracer namelist
+   USE trcnam_age        ! AGE SMS namelist
    USE trd_oce       
    USE trdtrc_oce
@@ -54,18 +58,56 @@
       !! ** Method  : - read passive tracer namelist 
       !!              - read namelist of each defined SMS model
-      !!                ( (PISCES, CFC, MY_TRC )
-      !!---------------------------------------------------------------------
-      INTEGER  ::   jn                  ! dummy loop indice
+      !!                ( (PISCES, CFC, MY_TRC, MEDUSA, IDTRA, Age )
+      !!---------------------------------------------------------------------
+      INTEGER  ::   jn, jk                     ! dummy loop indice
       !                                        !   Parameters of the run 
       IF( .NOT. lk_offline ) CALL trc_nam_run
       
       !                                        !  passive tracer informations
+# if defined key_debug_medusa
+      CALL flush(numout)
+      IF (lwp) write (numout,*) '------------------------------'
+      IF (lwp) write (numout,*) 'Jpalm - debug'
+      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_trc'
+      IF (lwp) write (numout,*) ' '
+# endif
+      !
       CALL trc_nam_trc
       
       !                                        !   Parameters of additional diagnostics
+# if defined key_debug_medusa
+      CALL flush(numout)
+      IF (lwp) write (numout,*) '------------------------------'
+      IF (lwp) write (numout,*) 'Jpalm - debug'
+      IF (lwp) write (numout,*) 'CALL trc_nam_trc -- OK'
+      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_dia'
+      IF (lwp) write (numout,*) ' '
+# endif
+      !
+
       CALL trc_nam_dia
 
       !                                        !   namelist of transport
+# if defined key_debug_medusa
+      CALL flush(numout)
+      IF (lwp) write (numout,*) '------------------------------'
+      IF (lwp) write (numout,*) 'Jpalm - debug'
+      IF (lwp) write (numout,*) 'CALL trc_nam_dia -- OK'
+      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_trp'
+      IF (lwp) write (numout,*) ' '
+# endif
+      !
       CALL trc_nam_trp
+      !
+# if defined key_debug_medusa
+      CALL flush(numout)
+      IF (lwp) write (numout,*) '------------------------------'
+      IF (lwp) write (numout,*) 'Jpalm - debug'
+      IF (lwp) write (numout,*) 'CALL trc_nam_trp -- OK'
+      IF (lwp) write (numout,*) 'continue trc_nam '
+      IF (lwp) write (numout,*) ' '
+      CALL flush(numout)
+# endif
+      !
 
 
@@ -89,4 +131,7 @@
          END DO
          WRITE(numout,*) ' '
+# if defined key_debug_medusa
+      CALL flush(numout)
+# endif
       ENDIF
 
@@ -107,6 +152,15 @@
             WRITE(numout,*)
          ENDIF
-      ENDIF
-
+# if defined key_debug_medusa
+      CALL flush(numout)
+# endif
+      ENDIF
+
+# if defined key_debug_medusa
+       DO jk = 1, jpk
+          WRITE(numout,*) '  level number: ', jk, 'rdttrc: ',rdttrc(jk),'rdttra: ', rdttra(jk),'nn_dttrc: ', nn_dttrc
+       END DO
+      CALL flush(numout)
+# endif
       
       rdttrc(:) = rdttra(:) * FLOAT( nn_dttrc )   ! vertical profile of passive tracer time-step
@@ -116,4 +170,7 @@
         WRITE(numout,*) '    Passive Tracer  time step    rdttrc  = ', rdttrc(1)
         WRITE(numout,*) 
+# if defined key_debug_medusa
+      CALL flush(numout)
+# endif
       ENDIF
 
@@ -143,11 +200,30 @@
                IF( ln_trdtrc(jn) ) WRITE(numout,*) '    compute ML trends for tracer number :', jn
             END DO
+         WRITE(numout,*) ' '
+         CALL flush(numout)
          ENDIF
 #endif
 
+# if defined key_debug_medusa
+      CALL flush(numout)
+      IF (lwp) write (numout,*) '------------------------------'
+      IF (lwp) write (numout,*) 'Jpalm - debug'
+      IF (lwp) write (numout,*) 'just before ice module for tracers call : '
+      IF (lwp) write (numout,*) ' '
+# endif
+      !
 
       ! Call the ice module for tracers
       ! -------------------------------
       CALL trc_nam_ice
+
+# if defined key_debug_medusa
+      CALL flush(numout)
+      IF (lwp) write (numout,*) '------------------------------'
+      IF (lwp) write (numout,*) 'Jpalm - debug'
+      IF (lwp) write (numout,*) 'Will now read SMS namelists : '
+      IF (lwp) write (numout,*) ' '
+# endif
+      !
 
       ! namelist of SMS
@@ -156,17 +232,84 @@
       ELSE                    ;   IF(lwp) WRITE(numout,*) '          PISCES not used'
       ENDIF
-
+      !
+# if defined key_debug_medusa
+      CALL flush(numout)
+      IF (lwp) write (numout,*) '------------------------------'
+      IF (lwp) write (numout,*) 'Jpalm - debug'
+      IF (lwp) write (numout,*) 'CALL trc_nam_pisces  -- OK'
+      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_medusa'
+      IF (lwp) write (numout,*) ' '
+# endif
+      !
+      IF( lk_medusa  ) THEN   ;   CALL trc_nam_medusa      ! MEDUSA  tracers
+      ELSE                    ;   IF(lwp) WRITE(numout,*) '          MEDUSA not used'
+      ENDIF
+      !
+# if defined key_debug_medusa
+      CALL flush(numout)
+      IF (lwp) write (numout,*) '------------------------------'
+      IF (lwp) write (numout,*) 'Jpalm - debug'
+      IF (lwp) write (numout,*) 'CALL trc_nam_medusa -- OK'
+      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_idtra'
+      IF (lwp) write (numout,*) ' '
+# endif
+      !
+      IF( lk_idtra   ) THEN   ;   CALL trc_nam_idtra       ! Idealize tracers
+      ELSE                    ;   IF(lwp) WRITE(numout,*) '          Idealize tracers not used'
+      ENDIF
+      !
+# if defined key_debug_medusa
+      CALL flush(numout)
+      IF (lwp) write (numout,*) '------------------------------'
+      IF (lwp) write (numout,*) 'Jpalm - debug'
+      IF (lwp) write (numout,*) 'CALL trc_nam_idtra -- OK'
+      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_cfc'
+      IF (lwp) write (numout,*) ' '
+# endif
+      !
       IF( lk_cfc     ) THEN   ;   CALL trc_nam_cfc         ! CFC     tracers
       ELSE                    ;   IF(lwp) WRITE(numout,*) '          CFC not used'
       ENDIF
-
+      !
+# if defined key_debug_medusa
+      CALL flush(numout)
+      IF (lwp) write (numout,*) '------------------------------'
+      IF (lwp) write (numout,*) 'Jpalm - debug'
+      IF (lwp) write (numout,*) 'CALL trc_nam_cfc -- OK'
+      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_c14'
+      IF (lwp) write (numout,*) ' '
+# endif
+      !
       IF( lk_c14b     ) THEN   ;   CALL trc_nam_c14b         ! C14 bomb     tracers
       ELSE                    ;   IF(lwp) WRITE(numout,*) '          C14 not used'
       ENDIF
-
+      !
+# if defined key_debug_medusa
+      CALL flush(numout)
+      IF (lwp) write (numout,*) '------------------------------'
+      IF (lwp) write (numout,*) 'Jpalm - debug'
+      IF (lwp) write (numout,*) 'CALL trc_nam_c14 -- OK'
+      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_age'
+      IF (lwp) write (numout,*) ' '
+# endif
+      !
+      IF( lk_age     ) THEN  ;   CALL trc_nam_age         ! AGE     tracer
+      ELSE                   ;   IF(lwp) WRITE(numout,*) '          AGE not used'
+      ENDIF
+      !
+# if defined key_debug_medusa
+      CALL flush(numout)
+      IF (lwp) write (numout,*) '------------------------------'
+      IF (lwp) write (numout,*) 'Jpalm - debug'
+      IF (lwp) write (numout,*) 'CALL trc_nam_age -- OK'
+      IF (lwp) write (numout,*) 'in trc_nam - CALL trc_nam -- OK'
+      IF (lwp) write (numout,*) ' '
+# endif
+      !
       IF( lk_my_trc  ) THEN   ;   CALL trc_nam_my_trc      ! MY_TRC  tracers
       ELSE                    ;   IF(lwp) WRITE(numout,*) '          MY_TRC not used'
       ENDIF
-      !
+       
+      IF(lwp)   CALL flush(numout)
    END SUBROUTINE trc_nam
 
@@ -216,4 +359,5 @@
          WRITE(numout,*) '   Use euler integration for TRC (y/n)          ln_top_euler  = ', ln_top_euler
          WRITE(numout,*) ' '
+        CALL flush(numout)
       ENDIF
       !
@@ -306,5 +450,6 @@
          ln_trc_wri(jn) =       sn_tracer(jn)%llsave
       END DO
-      
+      IF(lwp)  CALL flush(numout)      
+
     END SUBROUTINE trc_nam_trc
 
@@ -357,7 +502,16 @@
          WRITE(numout,*) '    frequency of outputs for biological trends  nn_writebio = ', nn_writebio
          WRITE(numout,*) ' '
-      ENDIF
-
-      IF( ln_diatrc .AND. .NOT. lk_iomput ) THEN 
+         CALL flush(numout)
+      ENDIF
+!!
+!! JPALM -- 17-07-2015 --
+!! MEDUSA is not yet up-to-date with the iom server.
+!! we use it for the main tracer, but not fully with diagnostics.
+!! will have to adapt it properly when visiting Christian Ethee
+!! for now, we change 
+!! IF( ln_diatrc .AND. .NOT. lk_iomput ) THEN
+!! to :
+!!
+      IF( ( ln_diatrc .AND. .NOT. lk_iomput ) .OR. ( ln_diatrc .AND. lk_medusa ) ) THEN 
          ALLOCATE( trc2d(jpi,jpj,jpdia2d), trc3d(jpi,jpj,jpk,jpdia3d),  &
            &       ctrc2d(jpdia2d), ctrc2l(jpdia2d), ctrc2u(jpdia2d) ,  & 
@@ -368,4 +522,6 @@
          trc3d(:,:,:,:) = 0._wp  ;   ctrc3d(:) = ' '   ;   ctrc3l(:) = ' '    ;    ctrc3u(:) = ' ' 
          !
+      !! ELSE IF  ( lk_iomput .AND. lk_medusa .AND. .NOT. ln_diatrc) THEN
+      !!    CALL trc_nam_iom_medusa
       ENDIF
 
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/trcrst.F90	(revision 8200)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/trcrst.F90	(revision 8201)
@@ -27,5 +27,21 @@
    USE trcnam_trp
    USE iom
+   USE ioipsl, ONLY : ju2ymds    ! for calendar
    USE daymod
+   !! AXY (05/11/13): need these for MEDUSA to input/output benthic reservoirs
+   USE sms_medusa
+   USE trcsms_medusa
+   !!
+#if defined key_idtra
+   USE trcsms_idtra
+#endif
+   !!
+#if defined key_cfc
+   USE trcsms_cfc
+#endif
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE sbc_oce, ONLY: lk_oasis 
+   USE oce,     ONLY: CO2Flux_out_cpl, DMS_out_cpl, chloro_out_cpl  !! Coupling variable
+
    IMPLICIT NONE
    PRIVATE
@@ -35,4 +51,7 @@
    PUBLIC   trc_rst_wri       ! called by ???
    PUBLIC   trc_rst_cal
+   PUBLIC   trc_rst_stat
+   PUBLIC   trc_rst_dia_stat
+   PUBLIC   trc_rst_tra_stat
 
    !! * Substitutions
@@ -48,4 +67,7 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt       ! number of iteration
+      INTEGER             ::   iyear, imonth, iday
+      REAL (wp)           ::   zsec
+      REAL (wp)           ::   zfjulday
       !
       CHARACTER(LEN=20)   ::   clkt     ! ocean time-step define as a character
@@ -78,7 +100,26 @@
       ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 2*nn_dttrc + 1
       IF( kt == nitrst - 2*nn_dttrc .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc .AND. .NOT. lrst_trc ) ) THEN
-         ! beware of the format used to write kt (default is i8.8, that should be large enough)
-         IF( nitrst > 1.0e9 ) THEN   ;   WRITE(clkt,*       ) nitrst
-         ELSE                        ;   WRITE(clkt,'(i8.8)') nitrst
+         IF ( ln_rstdate ) THEN
+            !! JPALM -- 22-12-2015 -- modif to get the good date on restart trc file name
+            !!                     -- the condition to open the rst file is not the same than for the dynamic rst.
+            !!                     -- here it - for an obscure reason - is open 2 time-step before the restart writing process
+            !!                     instead of 1.
+            !!                     -- i am not sure if someone forgot +1 in the if loop condition as
+            !!                     it is writen in all comments nitrst -2*nn_dttrc + 1 and the condition is 
+            !!                     nitrst - 2*nn_dttrc
+            !!                     -- nevertheless we didn't wanted to broke something already working 
+            !!                     and just adapted the part we added.
+            !!                     -- So instead of calling ju2ymds( fjulday + (rdttra(1)) 
+            !!                     we call ju2ymds( fjulday + (2*rdttra(1)) 
+            !!--------------------------------------------------------------------      
+            zfjulday = fjulday + (2*rdttra(1)) / rday
+            IF( ABS(zfjulday - REAL(NINT(zfjulday),wp)) < 0.1 / rday )   zfjulday = REAL(NINT(zfjulday),wp)   ! avoid truncation error
+            CALL ju2ymds( zfjulday + (2*rdttra(1)) / rday, iyear, imonth, iday, zsec )
+            WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday
+         ELSE
+            ! beware of the format used to write kt (default is i8.8, that should be large enough)
+            IF( nitrst > 1.0e9 ) THEN   ;   WRITE(clkt,*       ) nitrst
+            ELSE                        ;   WRITE(clkt,'(i8.8)') nitrst
+            ENDIF
          ENDIF
          ! create the file
@@ -101,5 +142,7 @@
       !! ** purpose  :   read passive tracer fields in restart files
       !!----------------------------------------------------------------------
-      INTEGER  ::  jn     
+      INTEGER  ::  jn, jl     
+      !! AXY (05/11/13): temporary variables
+      REAL(wp) ::    fq0,fq1,fq2
 
       !!----------------------------------------------------------------------
@@ -112,9 +155,226 @@
       DO jn = 1, jptra
          CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )
+         trn(:,:,:,jn) = trn(:,:,:,jn) * tmask(:,:,:)
       END DO
 
       DO jn = 1, jptra
          CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )
-      END DO
+         trb(:,:,:,jn) = trb(:,:,:,jn) * tmask(:,:,:)
+      END DO
+      !
+      !! AXY (09/06/14): the ARCHER version of MEDUSA-2 does not include an equivalent
+      !!                 call to MEDUSA-2 at this point; this suggests that the FCM
+      !!                 version of NEMO date significantly earlier than the current
+      !!                 version
+
+#if defined key_medusa
+      !! AXY (13/01/12): check if the restart contains sediment fields;
+      !!                 this is only relevant for simulations that include
+      !!                 biogeochemistry and are restarted from earlier runs
+      !!                 in which there was no sediment component
+      !!
+      IF( iom_varid( numrtr, 'B_SED_N', ldstop = .FALSE. ) > 0 ) THEN
+         !! YES; in which case read them
+         !!
+         IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields present - reading in ...'
+         CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_N',  zb_sed_n(:,:)  )
+         CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_N',  zn_sed_n(:,:)  )
+         CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_FE', zb_sed_fe(:,:) )
+         CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_FE', zn_sed_fe(:,:) )
+         CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_SI', zb_sed_si(:,:) )
+         CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_SI', zn_sed_si(:,:) )
+         CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_C',  zb_sed_c(:,:)  )
+         CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_C',  zn_sed_c(:,:)  )
+         CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_CA', zb_sed_ca(:,:) )
+         CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_CA', zn_sed_ca(:,:) )
+      ELSE
+         !! NO; in which case set them to zero
+         !!
+         IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields absent - setting to zero ...'
+         zb_sed_n(:,:)  = 0.0   !! organic N
+         zn_sed_n(:,:)  = 0.0
+         zb_sed_fe(:,:) = 0.0   !! organic Fe
+         zn_sed_fe(:,:) = 0.0
+         zb_sed_si(:,:) = 0.0   !! inorganic Si
+         zn_sed_si(:,:) = 0.0
+         zb_sed_c(:,:)  = 0.0   !! organic C
+         zn_sed_c(:,:)  = 0.0
+         zb_sed_ca(:,:) = 0.0   !! inorganic C
+         zn_sed_ca(:,:) = 0.0
+      ENDIF
+      !!
+      !! calculate stats on these fields
+      IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...'
+      call trc_rst_dia_stat(zn_sed_n(:,:), 'Sediment  N')
+      call trc_rst_dia_stat(zn_sed_fe(:,:), 'Sediment Fe')
+      call trc_rst_dia_stat(zn_sed_si(:,:), 'Sediment Si')
+      call trc_rst_dia_stat(zn_sed_c(:,:), 'Sediment C')
+      call trc_rst_dia_stat(zn_sed_ca(:,:), 'Sediment Ca')
+      !!
+      !! AXY (07/07/15): read in temporally averaged fields for DMS
+      !!                 calculations
+      !!
+      IF( iom_varid( numrtr, 'B_DMS_CHN', ldstop = .FALSE. ) > 0 ) THEN
+         !! YES; in which case read them
+         !!
+         IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS present - reading in ...'
+         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_CHN',  zb_dms_chn(:,:)  )
+         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_CHN',  zn_dms_chn(:,:)  )
+         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_CHD',  zb_dms_chd(:,:)  )
+         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_CHD',  zn_dms_chd(:,:)  )
+         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_MLD',  zb_dms_mld(:,:)  )
+         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_MLD',  zn_dms_mld(:,:)  )
+         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_QSR',  zb_dms_qsr(:,:)  )
+         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_QSR',  zn_dms_qsr(:,:)  )
+         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_DIN',  zb_dms_din(:,:)  )
+         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_DIN',  zn_dms_din(:,:)  )
+      ELSE
+         !! NO; in which case set them to zero
+         !!
+         IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS absent - setting to zero ...'
+         zb_dms_chn(:,:)  = 0.0   !! CHN
+         zn_dms_chn(:,:)  = 0.0
+         zb_dms_chd(:,:)  = 0.0   !! CHD
+         zn_dms_chd(:,:)  = 0.0
+         zb_dms_mld(:,:)  = 0.0   !! MLD
+         zn_dms_mld(:,:)  = 0.0
+         zb_dms_qsr(:,:)  = 0.0   !! QSR
+         zn_dms_qsr(:,:)  = 0.0
+         zb_dms_din(:,:)  = 0.0   !! DIN
+         zn_dms_din(:,:)  = 0.0
+      ENDIF
+      !!  
+      !! JPALM 14-06-2016 -- add CO2 flux and DMS surf through the restart
+      !!                  -- needed for the coupling with atm
+      IF( iom_varid( numrtr, 'N_DMS_srf', ldstop = .FALSE. ) > 0 ) THEN
+         IF(lwp) WRITE(numout,*) 'DMS surf concentration - reading in ...'
+         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_srf',  zb_dms_srf(:,:)  )
+         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_srf',  zn_dms_srf(:,:)  )
+      ELSE
+         IF(lwp) WRITE(numout,*) 'DMS surf concentration - setting to zero ...'
+         zb_dms_srf(:,:)  = 0.0   !! DMS
+         zn_dms_srf(:,:)  = 0.0
+      ENDIF
+      IF (lk_oasis) THEN
+         DMS_out_cpl(:,:) = zn_dms_srf(:,:)        !! Coupling variable
+      END IF
+      !!
+      IF( iom_varid( numrtr, 'B_CO2_flx', ldstop = .FALSE. ) > 0 ) THEN
+         IF(lwp) WRITE(numout,*) 'CO2 air-sea flux - reading in ...'
+         CALL iom_get( numrtr, jpdom_autoglo, 'B_CO2_flx',  zb_co2_flx(:,:)  )
+         CALL iom_get( numrtr, jpdom_autoglo, 'N_CO2_flx',  zn_co2_flx(:,:)  )
+      ELSE
+         IF(lwp) WRITE(numout,*) 'CO2 air-sea flux - setting to zero ...'
+         zb_co2_flx(:,:)  = 0.0   !! CO2 flx
+         zn_co2_flx(:,:)  = 0.0
+      ENDIF
+      IF (lk_oasis) THEN
+         CO2Flux_out_cpl(:,:) =  zn_co2_flx(:,:)   !! Coupling variable
+      END IF
+      !!
+      !! JPALM 02-06-2017 -- in complement to DMS surf 
+      !!                  -- the atm model needs surf Chl 
+      !!                     as proxy of org matter from the ocean
+      !!                  -- needed for the coupling with atm
+      IF( iom_varid( numrtr, 'N_CHL_srf', ldstop = .FALSE. ) > 0 ) THEN
+         IF(lwp) WRITE(numout,*) 'Chl surf concentration - reading in ...'
+         CALL iom_get( numrtr, jpdom_autoglo, 'N_CHL_srf',  zn_chl_srf(:,:)  )
+      ELSE
+         IF(lwp) WRITE(numout,*) 'Chl surf concentration - setting to zero ...'
+         zn_chl_srf(:,:)  = (trn(:,:,1,jpchn) + trn(:,:,1,jpchd)) * 1.E-6
+      ENDIF
+      IF (lk_oasis) THEN
+         chloro_out_cpl(:,:) = zn_chl_srf(:,:)        !! Coupling variable
+      END IF
+      !!
+      !! calculate stats on these fields
+      IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS stats (min, max, sum) ...'
+      call trc_rst_dia_stat(zn_dms_chn(:,:), 'DMS, CHN')
+      call trc_rst_dia_stat(zn_dms_chd(:,:), 'DMS, CHD')
+      call trc_rst_dia_stat(zn_dms_mld(:,:), 'DMS, MLD')
+      call trc_rst_dia_stat(zn_dms_qsr(:,:), 'DMS, QSR')
+      call trc_rst_dia_stat(zn_dms_din(:,:), 'DMS, DIN')
+      call trc_rst_dia_stat(zn_dms_srf(:,:), 'DMS surf')
+      call trc_rst_dia_stat(zn_co2_flx(:,:), 'CO2 flux')
+      call trc_rst_dia_stat(zn_chl_srf(:,:), 'CHL surf')
+      !!  
+      !! JPALM 14-06-2016 -- add Carbonate chenistry variables through the restart
+      !!                  -- needed for monthly call of carb-chem routine and better reproducibility
+# if defined key_roam
+      IF( iom_varid( numrtr, 'pH_3D', ldstop = .FALSE. ) > 0 ) THEN
+         IF(lwp) WRITE(numout,*) 'Carbonate chem variable - reading in ...'
+         CALL iom_get( numrtr, jpdom_autoglo, 'pH_3D'   ,  f3_pH(:,:,:)     )
+         CALL iom_get( numrtr, jpdom_autoglo, 'h2CO3_3D',  f3_h2co3(:,:,:)  )
+         CALL iom_get( numrtr, jpdom_autoglo, 'hCO3_3D' ,  f3_hco3(:,:,:)   )
+         CALL iom_get( numrtr, jpdom_autoglo, 'CO3_3D'  ,  f3_co3(:,:,:)    )
+         CALL iom_get( numrtr, jpdom_autoglo, 'omcal_3D',  f3_omcal(:,:,:)  )
+         CALL iom_get( numrtr, jpdom_autoglo, 'omarg_3D',  f3_omarg(:,:,:)  )
+         CALL iom_get( numrtr, jpdom_autoglo, 'CCD_CAL' ,  f2_ccd_cal(:,:)  )
+         CALL iom_get( numrtr, jpdom_autoglo, 'CCD_ARG' ,  f2_ccd_arg(:,:)  )
+         !!
+         IF(lwp) WRITE(numout,*) ' MEDUSA averaged Carb-chem stats (min, max, sum) ...'
+      call trc_rst_dia_stat( f3_pH(:,:,1)   ,'pH 3D surf')
+      call trc_rst_dia_stat( f3_h2co3(:,:,1),'h2CO3 3D surf')
+      call trc_rst_dia_stat( f3_hco3(:,:,1) ,'hCO3 3D surf' )
+      call trc_rst_dia_stat( f3_co3(:,:,1)  ,'CO3 3D surf' )
+      call trc_rst_dia_stat( f3_omcal(:,:,1),'omcal 3D surf')
+      call trc_rst_dia_stat( f3_omarg(:,:,1),'omarg 3D surf')
+      call trc_rst_dia_stat( f2_ccd_cal(:,:),'CCD_CAL')
+      call trc_rst_dia_stat( f2_ccd_arg(:,:),'CCD_ARG')
+
+      ELSE
+         IF(lwp) WRITE(numout,*) 'WARNING : No Carbonate-chem variable in the restart.... '
+         IF(lwp) WRITE(numout,*) 'Is not a problem if start a month, but may be very problematic if not '
+         IF(lwp) WRITE(numout,*) 'Check if   mod(kt*rdt,2592000) == rdt' 
+         IF(lwp) WRITE(numout,*) 'Or don t start from uncomplete restart...' 
+      ENDIF
+# endif
+
+
+#endif
+      !
+#if defined key_idtra
+      !! JPALM -- 05-01-2016 -- mv idtra and CFC restart reading and 
+      !!                        writting here undre their key.
+      !!                        problems in CFC restart, maybe because of this...
+      !!                        and pb in idtra diag or diad-restart writing.
+      !!----------------------------------------------------------------------
+      IF( iom_varid( numrtr, 'qint_IDTRA', ldstop = .FALSE. ) > 0 ) THEN
+         !! YES; in which case read them
+         !!
+         IF(lwp) WRITE(numout,*) ' IDTRA averaged properties present - reading in ...'
+         CALL iom_get( numrtr, jpdom_autoglo, 'qint_IDTRA',  qint_idtra(:,:,1)  )
+      ELSE
+         !! NO; in which case set them to zero
+         !!
+         IF(lwp) WRITE(numout,*) ' IDTRA averaged properties absent - setting to zero ...'
+         qint_idtra(:,:,1)  = 0.0   !! CHN
+      ENDIF
+      !!
+      !! calculate stats on these fields
+      IF(lwp) WRITE(numout,*) ' IDTRA averaged properties stats (min, max, sum) ...'
+      call trc_rst_dia_stat(qint_idtra(:,:,1), 'qint_IDTRA')
+#endif
+      !
+#if defined key_cfc
+      DO jl = 1, jp_cfc
+         jn = jp_cfc0 + jl - 1
+         IF( iom_varid( numrtr, 'qint_'//ctrcnm(jn), ldstop = .FALSE. ) > 0 ) THEN
+            !! YES; in which case read them
+            !!
+            IF(lwp) WRITE(numout,*) ' CFC averaged properties present - reading in ...'
+            CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) )
+         ELSE
+            !! NO; in which case set them to zero
+            !!
+            IF(lwp) WRITE(numout,*) ' CFC averaged properties absent - setting to zero ...'
+            qint_cfc(:,:,jn)  = 0.0   !! CHN
+         ENDIF
+         !!
+         !! calculate stats on these fields
+         IF(lwp) WRITE(numout,*) ' CFC averaged properties stats (min, max, sum) ...'
+         call trc_rst_dia_stat(qint_cfc(:,:,jl), 'qint_'//ctrcnm(jn))
+      END DO
+#endif
       !
    END SUBROUTINE trc_rst_read
@@ -128,6 +388,8 @@
       INTEGER, INTENT( in ) ::   kt    ! ocean time-step index
       !!
-      INTEGER  :: jn
+      INTEGER  :: jn, jl
       REAL(wp) :: zarak0
+      !! AXY (05/11/13): temporary variables
+      REAL(wp) ::    fq0,fq1,fq2
       !!----------------------------------------------------------------------
       !
@@ -142,5 +404,129 @@
          CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )
       END DO
-      !
+
+      !! AXY (09/06/14): the ARCHER version of MEDUSA-2 does not include an equivalent
+      !!                 call to MEDUSA-2 at this point; this suggests that the FCM
+      !!                 version of NEMO date significantly earlier than the current
+      !!                 version
+
+#if defined key_medusa
+      !! AXY (13/01/12): write out "before" and "now" state of seafloor
+      !!                 sediment pools into restart; this happens
+      !!                 whether or not the pools are to be used by
+      !!                 MEDUSA (which is controlled by a switch in the
+      !!                 namelist_top file)
+      !!
+      IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields - writing out ...'
+      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_N',  zb_sed_n(:,:)  )
+      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_N',  zn_sed_n(:,:)  )
+      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_FE', zb_sed_fe(:,:) )
+      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_FE', zn_sed_fe(:,:) )
+      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_SI', zb_sed_si(:,:) )
+      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_SI', zn_sed_si(:,:) )
+      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_C',  zb_sed_c(:,:)  )
+      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_C',  zn_sed_c(:,:)  )
+      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_CA', zb_sed_ca(:,:) )
+      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_CA', zn_sed_ca(:,:) )
+      !!
+      !! calculate stats on these fields
+      IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...'
+      call trc_rst_dia_stat(zn_sed_n(:,:), 'Sediment  N')
+      call trc_rst_dia_stat(zn_sed_fe(:,:), 'Sediment Fe')
+      call trc_rst_dia_stat(zn_sed_si(:,:), 'Sediment Si')
+      call trc_rst_dia_stat(zn_sed_c(:,:), 'Sediment C')
+      call trc_rst_dia_stat(zn_sed_ca(:,:), 'Sediment Ca')
+      !!
+      !! AXY (07/07/15): write out temporally averaged fields for DMS
+      !!                 calculations
+      !!
+      IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS - writing out ...'
+      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_CHN',  zb_dms_chn(:,:)  )
+      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_CHN',  zn_dms_chn(:,:)  )
+      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_CHD',  zb_dms_chd(:,:)  )
+      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_CHD',  zn_dms_chd(:,:)  )
+      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_MLD',  zb_dms_mld(:,:)  )
+      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_MLD',  zn_dms_mld(:,:)  )
+      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_QSR',  zb_dms_qsr(:,:)  )
+      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_QSR',  zn_dms_qsr(:,:)  )
+      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_DIN',  zb_dms_din(:,:)  )
+      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_DIN',  zn_dms_din(:,:)  )
+         !! JPALM 14-06-2016 -- add CO2 flux and DMS surf through the restart
+         !!                  -- needed for the coupling with atm
+      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_srf',  zb_dms_srf(:,:)  )
+      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_srf',  zn_dms_srf(:,:)  )
+      CALL iom_rstput( kt, nitrst, numrtw, 'B_CO2_flx',  zb_co2_flx(:,:)  )
+      CALL iom_rstput( kt, nitrst, numrtw, 'N_CO2_flx',  zn_co2_flx(:,:)  )
+      CALL iom_rstput( kt, nitrst, numrtw, 'N_CHL_srf',  zn_chl_srf(:,:)  )
+      !!
+      !! calculate stats on these fields
+      IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS stats (min, max, sum) ...'
+      call trc_rst_dia_stat(zn_dms_chn(:,:), 'DMS, CHN')
+      call trc_rst_dia_stat(zn_dms_chd(:,:), 'DMS, CHD')
+      call trc_rst_dia_stat(zn_dms_mld(:,:), 'DMS, MLD')
+      call trc_rst_dia_stat(zn_dms_qsr(:,:), 'DMS, QSR')
+      call trc_rst_dia_stat(zn_dms_din(:,:), 'DMS, DIN')
+      call trc_rst_dia_stat(zn_dms_srf(:,:), 'DMS surf')
+      call trc_rst_dia_stat(zn_co2_flx(:,:), 'CO2 flux')
+      call trc_rst_dia_stat(zn_chl_srf(:,:), 'CHL surf')
+      !!
+      IF(lwp) WRITE(numout,*) ' MEDUSA averaged prop. for dust and iron dep.'
+      call trc_rst_dia_stat(dust(:,:), 'Dust dep')
+      call trc_rst_dia_stat(zirondep(:,:), 'Iron dep')
+      !! 
+      !!  
+      !! JPALM 14-06-2016 -- add Carbonate chenistry variables through the restart
+      !!                  -- needed for monthly call of carb-chem routine and better reproducibility
+# if defined key_roam
+      IF(lwp) WRITE(numout,*) 'Carbonate chem variable - writing out ...'
+      CALL iom_rstput( kt, nitrst, numrtw, 'pH_3D'   ,  f3_pH(:,:,:)     )
+      CALL iom_rstput( kt, nitrst, numrtw, 'h2CO3_3D',  f3_h2co3(:,:,:)  )
+      CALL iom_rstput( kt, nitrst, numrtw, 'hCO3_3D' ,  f3_hco3(:,:,:)   )
+      CALL iom_rstput( kt, nitrst, numrtw, 'CO3_3D'  ,  f3_co3(:,:,:)    )
+      CALL iom_rstput( kt, nitrst, numrtw, 'omcal_3D',  f3_omcal(:,:,:)  )
+      CALL iom_rstput( kt, nitrst, numrtw, 'omarg_3D',  f3_omarg(:,:,:)  )
+      CALL iom_rstput( kt, nitrst, numrtw, 'CCD_CAL' ,  f2_ccd_cal(:,:)  )
+      CALL iom_rstput( kt, nitrst, numrtw, 'CCD_ARG' ,  f2_ccd_arg(:,:)  )
+      !!
+      IF(lwp) WRITE(numout,*) ' MEDUSA averaged Carb-chem stats (min, max, sum) ...'
+      call trc_rst_dia_stat( f3_pH(:,:,1)   ,'pH 3D surf')
+      call trc_rst_dia_stat( f3_h2co3(:,:,1),'h2CO3 3D surf')
+      call trc_rst_dia_stat( f3_hco3(:,:,1) ,'hCO3 3D surf' )
+      call trc_rst_dia_stat( f3_co3(:,:,1)  ,'CO3 3D surf' )
+      call trc_rst_dia_stat( f3_omcal(:,:,1),'omcal 3D surf')
+      call trc_rst_dia_stat( f3_omarg(:,:,1),'omarg 3D surf')
+      call trc_rst_dia_stat( f2_ccd_cal(:,:),'CCD_CAL')
+      call trc_rst_dia_stat( f2_ccd_arg(:,:),'CCD_ARG')
+      !!
+# endif
+!!
+#endif
+      !
+#if defined key_idtra
+      !! JPALM -- 05-01-2016 -- mv idtra and CFC restart reading and 
+      !!                        writting here undre their key.
+      !!                        problems in CFC restart, maybe because of this...
+      !!                        and pb in idtra diag or diad-restart writing.
+      !!----------------------------------------------------------------------
+      IF(lwp) WRITE(numout,*) ' IDTRA averaged properties - writing out ...'
+      CALL iom_rstput( kt, nitrst, numrtw, 'qint_IDTRA',  qint_idtra(:,:,1) )
+      !!
+      !! calculate stats on these fields
+      IF(lwp) WRITE(numout,*) ' IDTRA averaged properties stats (min, max, sum) ...'
+      call trc_rst_dia_stat(qint_idtra(:,:,1), 'qint_IDTRA')
+#endif
+      !
+#if defined key_cfc
+      DO jl = 1, jp_cfc
+         jn = jp_cfc0 + jl - 1
+         IF(lwp) WRITE(numout,*) ' CFC averaged properties - writing out ...'
+         CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) )
+         !!
+         !! calculate stats on these fields
+         IF(lwp) WRITE(numout,*) ' CFC averaged properties stats (min, max, sum) ...'
+         call trc_rst_dia_stat(qint_cfc(:,:,jl), 'qint_'//ctrcnm(jn))
+      END DO
+#endif
+      !
+
       IF( kt == nitrst ) THEN
           CALL trc_rst_stat            ! statistics
@@ -304,9 +690,84 @@
          IF(lwp) WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax, zdrift
       END DO
-      WRITE(numout,*) 
+      IF(lwp) WRITE(numout,*) 
 9000  FORMAT(' tracer nb :',i2,'    name :',a10,'    mean :',e18.10,'    min :',e18.10, &
       &      '    max :',e18.10,'    drift :',e18.10, ' %')
       !
    END SUBROUTINE trc_rst_stat
+
+
+   SUBROUTINE trc_rst_tra_stat
+      !!----------------------------------------------------------------------
+      !!                    ***  trc_rst_tra_stat  ***
+      !!
+      !! ** purpose  :   Compute tracers statistics - check where crazy values appears
+      !!----------------------------------------------------------------------
+      INTEGER  :: jk, jn
+      REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift, areasf
+      REAL(wp), DIMENSION(jpi,jpj) :: zvol
+      !!----------------------------------------------------------------------
+
+      IF( lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '           ----SURFACE TRA STAT----             '
+         WRITE(numout,*)
+      ENDIF
+      !
+      zvol(:,:) = e1e2t(:,:) * fse3t_a(:,:,1) * tmask(:,:,1)
+      areasf = glob_sum(zvol(:,:))
+      DO jn = 1, jptra
+         ztraf = glob_sum( tra(:,:,1,jn) * zvol(:,:) )
+         zmin  = MINVAL( tra(:,:,1,jn), mask= ((tmask(:,:,1).NE.0.)) )
+         zmax  = MAXVAL( tra(:,:,1,jn), mask= ((tmask(:,:,1).NE.0.)) )
+         IF( lk_mpp ) THEN
+            CALL mpp_min( zmin )      ! min over the global domain
+            CALL mpp_max( zmax )      ! max over the global domain
+         END IF
+         zmean  = ztraf / areasf
+         IF(lwp) WRITE(numout,9001) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax
+      END DO
+      IF(lwp) WRITE(numout,*)
+9001  FORMAT(' tracer nb :',i2,'    name :',a10,'    mean :',e18.10,'    min :',e18.10, &
+      &      '    max :',e18.10)
+      !
+   END SUBROUTINE trc_rst_tra_stat
+
+
+
+   SUBROUTINE trc_rst_dia_stat( dgtr, names)
+      !!----------------------------------------------------------------------
+      !!                    ***  trc_rst_dia_stat  ***
+      !!
+      !! ** purpose  :   Compute tracers statistics
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) ::   dgtr      ! 2D diag var
+      CHARACTER(len=*)             , INTENT(in) ::   names     ! 2D diag name
+      !!---------------------------------------------------------------------
+      INTEGER  :: jk, jn
+      REAL(wp) :: ztraf, zmin, zmax, zmean, areasf
+      REAL(wp), DIMENSION(jpi,jpj) :: zvol
+      !!----------------------------------------------------------------------
+
+      IF( lwp )  WRITE(numout,*) 'STAT- ', names
+      !
+      zvol(:,:) = e1e2t(:,:) * fse3t_a(:,:,1) * tmask(:,:,1)
+      ztraf = glob_sum( dgtr(:,:) * zvol(:,:) )
+      !! areasf = glob_sum(e1e2t(:,:) * tmask(:,:,1) )
+      areasf = glob_sum(zvol(:,:))
+      zmin  = MINVAL( dgtr(:,:), mask= ((tmask(:,:,1).NE.0.)) )
+      zmax  = MAXVAL( dgtr(:,:), mask= ((tmask(:,:,1).NE.0.)) )
+      IF( lk_mpp ) THEN
+         CALL mpp_min( zmin )      ! min over the global domain
+         CALL mpp_max( zmax )      ! max over the global domain
+      END IF
+      zmean  = ztraf / areasf
+      IF(lwp) WRITE(numout,9002) TRIM( names ), zmean, zmin, zmax
+      !
+      IF(lwp) WRITE(numout,*)
+9002  FORMAT(' tracer name :',a10,'    mean :',e18.10,'    min :',e18.10, &
+      &      '    max :',e18.10 )
+      !
+   END SUBROUTINE trc_rst_dia_stat
+
 
 #else
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/trcsms.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/trcsms.F90	(revision 8200)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/trcsms.F90	(revision 8201)
@@ -16,6 +16,9 @@
    USE trc                !
    USE trcsms_pisces      ! PISCES biogeo-model
+   USE trcsms_medusa      ! MEDUSA tracers
+   USE trcsms_idtra       ! Idealize Tracer
    USE trcsms_cfc         ! CFC 11 & 12
    USE trcsms_c14b        ! C14b tracer 
+   USE trcsms_age         ! AGE tracer 
    USE trcsms_my_trc      ! MY_TRC  tracers
    USE prtctl_trc         ! Print control for debbuging
@@ -43,4 +46,5 @@
       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index      
       !!
+      INTEGER            ::  jn
       CHARACTER (len=25) :: charout
       !!---------------------------------------------------------------------
@@ -49,6 +53,29 @@
       !
       IF( lk_pisces  )   CALL trc_sms_pisces ( kt )    ! main program of PISCES 
+      IF( lk_medusa  )   CALL trc_sms_medusa ( kt )    ! MEDUSA  tracers
+# if defined key_debug_medusa
+         IF(lwp) WRITE(numout,*) '--trcsms : MEDUSA OK --  next IDTRA -- '
+      CALL flush(numout)
+# endif
+      IF( lk_idtra   )   CALL trc_sms_idtra  ( kt )    ! radioactive decay of Id. tracer
+# if defined key_debug_medusa
+         IF(lwp) WRITE(numout,*) '--trcsms : IDTRA OK --  next CFC -- '
+      CALL flush(numout)
+# endif
       IF( lk_cfc     )   CALL trc_sms_cfc    ( kt )    ! surface fluxes of CFC
+# if defined key_debug_medusa
+         IF(lwp) WRITE(numout,*) '--trcsms : CFC OK --  next C14 -- '
+      CALL flush(numout)
+# endif
       IF( lk_c14b    )   CALL trc_sms_c14b   ( kt )    ! surface fluxes of C14
+# if defined key_debug_medusa
+         IF(lwp) WRITE(numout,*) '--trcsms : C14 OK --  next C14 -- '
+      CALL flush(numout)
+# endif
+      IF( lk_age     )   CALL trc_sms_age    ( kt )    ! AGE tracer
+# if defined key_debug_medusa
+         IF(lwp) WRITE(numout,*) '--trcsms : Age OK --  Continue  -- '
+      CALL flush(numout)
+# endif
       IF( lk_my_trc  )   CALL trc_sms_my_trc ( kt )    ! MY_TRC  tracers
 
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/trcstp.F90	(revision 8200)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/trcstp.F90	(revision 8201)
@@ -55,4 +55,7 @@
       !!              Update the passive tracers
       !!-------------------------------------------------------------------
+
+      USE dom_oce, ONLY: narea
+
       INTEGER, INTENT( in ) ::  kt      ! ocean time-step index
       INTEGER               ::  jk, jn  ! dummy loop indices
@@ -87,5 +90,13 @@
          tra(:,:,:,:) = 0.e0
          !
+# if defined key_debug_medusa
+         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp begins at kt =', kt
+         CALL flush(numout)
+# endif
                                    CALL trc_rst_opn  ( kt )       ! Open tracer restart file 
+# if defined key_debug_medusa
+                                   CALL trc_rst_stat 
+                                   CALL trc_rst_tra_stat
+# endif
          IF( lrst_trc )            CALL trc_rst_cal  ( kt, 'WRITE' )   ! calendar
          IF( lk_iomput ) THEN  ;   CALL trc_wri      ( kt )       ! output of passive tracers with iom I/O manager
@@ -93,5 +104,17 @@
          ENDIF
                                    CALL trc_sms      ( kt )       ! tracers: sinks and sources
+# if defined key_debug_medusa
+         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp SMS complete at kt =', kt
+         CALL trc_rst_stat
+         CALL trc_rst_tra_stat
+         CALL flush(numout)
+# endif
                                    CALL trc_trp      ( kt )       ! transport of passive tracers
+# if defined key_debug_medusa
+         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp transport complete at kt =', kt
+         CALL trc_rst_stat
+         CALL trc_rst_tra_stat
+         CALL flush(numout)
+# endif
          IF( kt == nittrc000 ) THEN
             CALL iom_close( numrtr )       ! close input tracer restart file
@@ -102,13 +125,28 @@
          !
          IF( nn_dttrc /= 1   )     CALL trc_sub_reset( kt )       ! resetting physical variables when sub-stepping
-         !
-      ENDIF
-      !
-      ztrai = 0._wp                                                   !  content of all tracers
-      DO jn = 1, jptra
-         ztrai = ztrai + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   )
-      END DO
-      IF( lwp ) WRITE(numstr,9300) kt,  ztrai / areatot
-9300  FORMAT(i10,e18.10)
+# if defined key_debug_medusa
+         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp ends at kt =', kt
+         CALL flush(numout)
+# endif
+         !
+      ENDIF
+      !
+      IF (ln_ctl) THEN 
+         ! The following code is very expensive since it involves multiple 
+         ! reproducible global sums over all tracer fields and is potentially  
+         ! called on every timestep. The results it produces are purely for 
+         ! informational purposes and do not affect model evolution. 
+         ! Hence we restrict its use by protecting it with the ln_ctl RTL 
+         ! which should normally only be used under debugging conditions 
+         ! and not in operational runs. We also need to restrict output  
+         ! to the master PE since there's no point duplicating the same results 
+         ! on all processors.    
+         ztrai = 0._wp                                                   !  content of all tracers
+         DO jn = 1, jptra
+            ztrai = ztrai + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   )
+         END DO
+         IF( numstr /= -1 ) WRITE(numstr,9300) kt,  ztrai / areatot
+9300     FORMAT(i10,e18.10)
+      ENDIF
       !
       IF( nn_timing == 1 )   CALL timing_stop('trc_stp')
Index: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/trcwri.F90
===================================================================
--- branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/trcwri.F90	(revision 8200)
+++ branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/trcwri.F90	(revision 8201)
@@ -5,4 +5,5 @@
    !!======================================================================
    !! History :   1.0  !  2009-05 (C. Ethe)  Original code
+   !!              -   !  2014-06 (A. Yool, J. Palmieri) adding MEDUSA-2
    !!----------------------------------------------------------------------
 #if defined key_top && defined key_iomput
@@ -21,4 +22,7 @@
    USE trcwri_c14b
    USE trcwri_my_trc
+   USE trcwri_medusa
+   USE trcwri_idtra
+   USE trcwri_age
 
    IMPLICIT NONE
@@ -57,6 +61,9 @@
       ! ---------------------------------------
       IF( lk_pisces  )   CALL trc_wri_pisces     ! PISCES 
+      IF( lk_medusa  )   CALL trc_wri_medusa     ! MESDUSA
+      IF( lk_idtra   )   CALL trc_wri_idtra       ! Idealize tracers
       IF( lk_cfc     )   CALL trc_wri_cfc        ! surface fluxes of CFC
       IF( lk_c14b    )   CALL trc_wri_c14b       ! surface fluxes of C14
+      IF( lk_age     )   CALL trc_wri_age        ! AGE tracer
       IF( lk_my_trc  )   CALL trc_wri_my_trc     ! MY_TRC  tracers
       !
